Shareware Super Platinum 8/Shareware Super Platinum 8.iso/mac/PROGTOOL/LIB211.ZIP;1/DIALOGS.PRG

Text File | 1993-11-22 | 233.1 KB | 5,788 lines

*-----------------------------------------------------------------------
*-- Program...: DIALOGS.PRG
*-- Programmer: Kenneth J. Mayer
*-- Date......: 08/03/1993
*-- Notes.....: This program, which is part of the dUFLP library,
*--             contains copies of dialog box routines from various
*--             places in the library.
*-----------------------------------------------------------------------

FUNCTION Message1
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 05/24/1991
*-- Notes.......: Displays a message, centered at whatever line you
*--               give, pauses until user presses a key.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/19/1991 Modified by Ken Mayer from Miriam's
*--                procedure to function
*-- Calls.......: CENTER               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: message1(<nLine>,<nWidth>,"<cColor>","<cText>")
*-- Example.....: cDummy = Message1(5,12,"RG+/GB","All Done.")
*-- Returns.....: numeric value of key pressed by user (cUser)
*-- Parameters..: nLine  = Line to display message
*--               nWidth = Width of screen
*--               cColor = Colors for display
*--               cText  = Text to be displayed.
*-----------------------------------------------------------------------

   parameters nLine,nWidth,cColor,cText
   private cCursor, cUser

   @m->nLine,0
   cCursor = set("CURSOR")  && store current state of CURSOR
   set cursor off           && turn it off
   do center with m->nLine,m->nWidth,m->cColor,m->cText
   m->cUser = inkey(0)
   set cursor &cCursor.     && set cursor to original state
   @m->nLine,0              && erase line ...

RETURN m->cUser
*-- EoF: Message1()

FUNCTION Message2
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 06/08/1992
*-- Notes.......: Displays a message in a window, pauses for user to
*--               press key
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer to a function
*--               04/29/1991 - Modified by Ken Mayer to add shadow
*--               06/08/1992 - Modified by same, to do EXPLICIT setting
*--                            of colors for window used.
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: message2("<cText>","<cColor>")
*-- Example.....: cDummy = message2("Finished Processing!",;
*--                         "RG+/GB,,RG+/GB")
*-- Returns.....: numeric value of key pressed by user (cUser)
*-- Parameters..: cText  = Text to be displayed in window
*--               cColor = Colors for window
*-----------------------------------------------------------------------

   parameters cText,cColor
   private cCursor, cUser

   cCursor = set("CURSOR")
   set cursor off
   save screen to sMessage

   *-- NOW we see what happens ...
   activate screen
   define window wMessage from 10,10 to 14,70 double color &cColor.
   do shadow with 10,10,14,70
   activate window wMessage

   do center with 1,60,"",m->cText
   wait "" to m->cUser

   *-- cleanup
   set cursor &cCursor.

   *-- remove window ...
   release window wMessage
   restore screen from sMessage
   release screen sMessage

RETURN m->cUser
*-- EoF: Message2()

FUNCTION Message3
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 06/08/1992
*-- Notes.......: Displays a message in a window, pauses for user,
*--               will wrap a long message inside the window.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer to a function
*--               04/29/1991 - Modified to Ken Mayer add shadow
*--               06/08/1992 - Modified to explicitly set the colors ...
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: Message3("<cText>","<cColor>")
*-- Example.....: cDummy = Message3("This is a long message that will"+;
*--                                 " be wrapped around inside the "+;
*--                                  "window.","rg+/gb,,rg+/gb")
*-- Returns.....: numeric value of key used to exit window (cUser)
*-- Parameters..: cText  = Text to be displayed
*--               cColor = Colors for window
*-----------------------------------------------------------------------

   parameters cText,cColor
   private nLines,cCursor,cUser,nLMargin,nRMargin,cAlignment,lWrap

   m->nLines = int(len(m->cText) / 38) + 5  && set # of lines for window

   cCursor = set("CURSOR")
   set cursor off
   save screen to sMessage

   *-- define/activate window
   activate screen
   define window wMessage from 8,20 to 8+m->nLines,60 double ;
                  color &cColor.
   do shadow with 8,20,8+m->nLines,60
   activate window wMessage

   m->nLMargin   = _lmargin
   m->nRMargin   = _rmargin
   m->cAlignment = _alignment
   m->lWrap      = _wrap

   _lmargin   = 1
   _rmargin   = 38
   _alignment = "CENTER"
   _wrap      = .t.

   ?cText
   ?
   wait "    Press any key to continue . . ." to m->cUser

   _lmargin   = m->nLMargin
   _rmargin   = m->nRMargin
   _alignment = m->cAlignment
   _wrap      = m->lWrap

   set cursor &cCursor.
   release window wMessage
   restore screen from sMessage
   release screen sMessage

RETURN m->cUser
*-- EoF: Message3()

FUNCTION Message4
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 11/09/1992
*-- Notes.......: Displays a 2-line message in a predefined window
*--                 and pauses
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer to a function
*--               04/29/1991 - Modified to Ken Mayer add shadow
*--               06/08/1992 -- Modified to explicitly deal with colors
*--               11/09/1992 - Modified by Joey Carroll to deal with
*--                            text parameters being too long.
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: message4("<cText1>","<cText2>","<cColor>")
*-- Example.....: cDummy = message4("Finished processing.","There are ";
*--                        +ltrim(str(reccount()))+;
*--                        " Records in this file.",;
*--                        "rg+/rg,rg+/rg,rg+/rg")
*-- Returns.....: numeric value of key pressed by user to exit window
*--               (cUser)
*-- Parameters..: cText1 = First line of message
*--               cText2 = Second line of message
*--               cColor = Colors for window
*-----------------------------------------------------------------------

   parameters cText1,cText2,cColor
   private cCursor,cUser,nLMargin,nRMargin,lWrap

   *-- if text params are too long, cut 'em off
   m->cText1 = left(m->cText1,58)
   m->cText2 = left(m->cText2,58)

   cCursor = set("CURSOR")
   set cursor off
   save screen to sMessage

   activate screen
   define window wMonitor from 10,10 to 17,70 double color &cColor.
   do shadow with 10,10,17,70
   activate window wMonitor

   m->nLMargin = _lmargin
   m->nRMargin = _rmargin
   m->lWrap =    _wrap
   _lmargin = 1
   _rmargin = 58
   _wrap    = .t.

   do center with 1,58,"",m->cText1
   do center with 2,58,"",m->cText2
   do center with 4,58,"","Press any key to continue . . ."
   wait "" to m->cUser

   _lmargin = m->nLMargin
   _rmargin = m->nRMargin
   _wrap    = m->lWrap
   set cursor &cCursor.
   release window wMonitor
   restore screen from sMessage
   release screen sMessage

RETURN m->cUser
*-- EoF: Message4()

FUNCTION ScrnHead
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 05/23/1991
*-- Notes.......: Displays a heading on the screen in a box 2
*--               spaces wider than the text, with a custom border
*--               (double line top, single the rest)
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 4/29/1991 - Modified by Ken Mayer to add shadow
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: scrnhead("<cColor>","<cText>")
*-- Examples....: cDummy = ScrnHead("rg+/gb","Print Financial Report")
*-- Returns.....: nul/""
*-- Parameters..: cColor = Colors to display box/text in
*--               cText  = text to be displayed.
*-----------------------------------------------------------------------

   parameters cColor,cText
   private cTextStart,cText2

   m->cText2 = " "+trim(m->cText)+" "     && ad spaces to left and right
   m->cTextstart = (80-len(trim(m->cText2)))/2
   activate screen
   do shadow with 1,m->cTextstart-1,3,81-m->cTextstart
   @1,m->cTextstart-1 to 3,81-m->cTextstart ;
           205,196,179,179,213,184,192,217 color &cColor. && display box
   @2, m->cTextstart say m->cText2 color &cColor.        && display text

RETURN ""
*-- EoF: ScrnHead()

FUNCTION ScrnHead2
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 03/17/1993
*-- Notes.......: Displays a heading on the screen in a box 2
*--               spaces wider than the text, with a 3-d border.
*--               WARNING: This dialog box is two rows taller and two
*--               columns wider than previous versions. For the purposes
*--               of screen control, I moved this up to row 0 on the
*--               screen (you may need to SET SCOREBOARD OFF), and
*--               down one further row, so all screen changes should
*--               start at row 6, or you will destroy the shadow ...
*--               (it's only one extra row, but it will make a
*--               difference)
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 04/29/1991 - Modified by Ken Mayer to add shadow
*--               03/17/1993 -- Changed to give 3-D Border
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               BORD3D2              Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: scrnhead2("<cColor>","<cText>"[,<nStyle>])
*-- Examples....: cDummy=ScrnHead2("rg+/gb","Print Financial Report",1)
*-- Returns.....: nul/""
*-- Parameters..: cColor = Colors to display box/text in
*--               cText  = text to be displayed.
*--               nStyle = Type of 3-d Border (passed directly to
*--                        procedure)
*--                        1 = raised, 2 = inset
*-----------------------------------------------------------------------

   parameters cColor,cText, nStyle
   private nTextStart,cText2

   *-- if style parameter not passed, use default
   if pCount() < 3
      m->nStyle = 1
   endif

   *-- deal with border -- save old setting, set to single
   cBorder = set("BORDER")
   set border to single

   m->cText2 = " "+trim(m->cText)+" "     && ad spaces to left and right
   m->nTextStart = (81-len(trim(m->cText2)))/2
                                          && centered text on screen
   activate screen
   m->nTop    = 0
   m->nLeft   = m->nTextStart - 3      && back up 3
   m->nBottom = 4                      && bottom row
   m->nRight  = (81-m->nTextStart) + 3 && right 3

   *-- draw shadow
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight

   *-- fill in box
   @m->nTop,m->nLeft fill to m->nBottom,m->nRight color &cColor.

   *-- place border on top of it all
   do bord3d2 with m->nTop,m->nLeft,m->nBottom,m->nRight,;
                   m->cColor,m->nStyle

   *-- finally, let's display the text ...
   @2, m->nTextStart say m->cText2 color &cColor. && display text

RETURN ""
*-- EoF: ScrnHead2()

FUNCTION ScrnHead3
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 06/09/1993
*-- Notes.......: Displays a heading on the screen in a box 2
*--               spaces wider than the text. This comes with a three-d
*--               border.
*--               NOTE: This routine is based on the work of Miriam
*--               Liskin, and my own modifications over the years.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/09/1993 -- Original
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               BORD3D5              Procedure in DIALOGS.PRG
*-- Called by...: Any
*-- Usage.......: scrnhead3("<cColor>","<cText>"[,<nStyle>])
*-- Examples....: cDummy =ScrnHead3("rg+/gb","Print Financial Report",1)
*-- Returns.....: nul/""
*-- Parameters..: cColor = Colors to display box/text in
*--                        Default to grey
*--               cText  = text to be displayed.
*--               nStyle = Type of 3-d Border (passed directly to
*--                        procedure)
*--                        1 = double - raised   (Default)
*--                        2 = double - recessed
*--                        3 = single - raised
*--                        4 = single - recessed
*-----------------------------------------------------------------------

   parameters cColor,cText, nStyle
   private nTextStart,cText2

   *-- if style parameter not passed, use default
   if pCount() < 3 .or. (m->nStyle < 1 .or. m->nStyle > 4)
      m->nStyle = 1
   endif

   *-- colors
   if isblank(m->cColor)
      m->cColor = "n/w"
   endif

   m->cText2 = " "+trim(m->cText)+" "     && ad spaces to left and right
   m->nTextStart = (81-len(trim(m->cText2)))/2
                                          && centered text on screen
   activate screen
   m->nTop    = iif(m->nStyle < 3,0,1)
   m->nLeft   = m->nTextStart - iif(m->nStyle<3,3,2)
                                          && back up 3 (or 2)
   m->nBottom = iif(m->nStyle < 3,4,3)    && bottom row
   m->nRight  = (81-m->nTextStart) + iif(m->nStyle<3,3,2)
                                          && right 3 (or 2)

   *-- draw shadow
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight

   *-- fill in box
   @m->nTop,m->nLeft fill to m->nBottom,m->nRight color &cColor.

   *-- place border on top of it all
   do bord3d5 with m->nTop,m->nLeft,m->nBottom,m->nRight,;
                                    m->cColor,m->nStyle

   *-- finally, let's display the text ...
   @2, m->nTextStart say m->cText2 color &cColor. && display text

RETURN ""
*-- EoF: ScrnHead3()

FUNCTION YesNo
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 06/08/1992
*-- Notes.......: Asks a yes/no question in a dialog window/box
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer to become a
*--                            function
*--               04/29/1991 - Modified by Ken Mayer add shadow
*--               05/13/1991 - Modified by Ken Mayer remove need for
*--                            extra procedures (YES/NO) that were used
*--                            for returning values from Menu
*--                            (suggested by Clinton L. Warren (VBCES))
*--               01/20/1992 - Modified by Martin Leon (HMan) to handle
*--                            user pressing 'Y' or 'N' keys (with ON
*--                            KEY ...).
*--               04/22/1992 - Modified by Ken Mayer adding CLEAR
*--                            TYPEAHEAD, as occaisional problems appear
*--                            otherwise.
*--               06/08/1992 - Modified (Ken Mayer) to deal with
*--                            explicit color processing.
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: yesno(<lAnswer>,"<cMess1>","<cMess2>","<cMess3>",;
*--                    "<cColor>")
*-- Example.....: if YesNo(.t.,"Do You Really Wish To Delete?",;
*--                            "This will destroy the data";
*--                             "in this record.";
*--                             "rg+/gb,n/w,rg+/gb")
*--                  delete
*--               else
*--                  skip
*--               endif
*--
*--                 The middle set of colors should be different, as
*--                 they will be the colors of the YES/NO selections ...
*--                 Options may be blank by using nul values ("")
*-- Returns.....: .t./.f. depending on user's choice from menu
*-- Parameters..: lAnswer = default value (Yes or No) for menu
*--               cMess1  =  First line of Message
*--               cMess2  =  Second line of message
*--               cMess3  =  Third line of message
*--               cColor  =  Colors for window/menu/box
*-----------------------------------------------------------------------

   parameter lAnswer,cMess1,cMess2,cMess3,cColor

   save screen to sYesno
   activate screen
   define window wYesno from 8,20 to 15,60 double color &cColor.

   define menu mYesno
   *-- remove && from MESSAGE option if using or might be used on
   *-- Mono system
   define pad pYes of mYesno Prompt "[Yes]" at 5,10 && message "Yes"
   define pad pNo  of mYesno Prompt "[No]"  at 5,25 && message "No"
   on selection pad pYes of mYesno deactivate menu
   on selection pad pNo  of mYesno deactivate menu

   do shadow with 8,20,15,60
   activate window wYesno

   do center with 0,38,"",m->cMess1           && center the text
   do center with 2,38,"",m->cMess2
   do center with 3,38,"",m->cMess3

   *-- deal with user pressing 'Y' or 'N' ...
   on key label Y keyboard IIF( PAD() = "PYES", "", CHR(19) )+chr(13)
   on key label N keyboard IIF( PAD() = "PNO",  "", CHR(4)  )+chr(13)

   *-- otherwise deal with regular "menu" abilities
   clear typeahead
   if m->lAnswer
      activate menu mYesno pad pYes
   else
      activate menu mYesno pad pNo
   endif

   *-- clear out ON KEY settings ...
   on key label Y
   on key label N
   release window wYesno
   restore screen from sYesno
   release screen sYesno
   release menu mYesno

RETURN iif(pad()="PYES",.t.,.f.)
*-- EoF: YesNo()

FUNCTION YesNo2
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 06/08/1992
*-- Notes.......: Asks a yes/no question in a dialog window/box
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer to become a
*--                            function
*--               04/29/1991 - Modified by Ken Mayer add shadow
*--               05/13/1991 - Modified by Ken Mayer remove need for
*--                            extra procedures (YES/NO) that were used
*--                            for returning values from Menu
*--                            (suggested by Clinton L. Warren (VBCES))
*--               11/15/1991 - Copied YesNo, modified to allow
*--                            "location" options -- useful for some
*--                            screens ...
*--               01/20/1992 - Modified by Martin Leon (HMAN) to allow
*--                            user to press 'Y' or 'N' and have them
*--                            recognized ...
*--               04/22/1992 - Modified by Ken Mayer adding CLEAR
*--                            TYPEAHEAD, as occaisional problems appear
*--                            otherwise.
*--               06/08/1992 - Modified by same for explicit color sets.
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: yesno2(<lAnswer>,"<cWhere>",;
*--                                "<cMess1>","<cMess2>","<cMess3>",;
*--                                "<cColor>")
*-- Example.....: if YesNo2(.t.,"UL","Do You Really Wish To Delete?",;
*--                            "This will destroy the data";
*--                             "in this record.";
*--                             "rg+/gb,n/w,rg+/gb")
*--                  delete
*--               else
*--                  skip
*--               endif
*--
*--                 The middle set of colors should be different, as
*--                 they will be the colors of the YES/NO selections ...
*--                 Options may be blank by using nul values ("")
*-- Returns.....: .t./.f. depending on user's choice from menu
*-- Parameters..: lAnswer = default value (Yes or No) for menu
*--               cWhere  = location on screen:
*--                            "UL" = Upper Left
*--                            "UC" = Upper Center
*--                            "UR" = Upper Right
*--                            "CL" = Center Left
*--                            "CC" = Center Center
*--                            "CR" = Center Right
*--                            "BL" = Bottom Left
*--                            "BC" = Bottom Center
*--                            "BR" = Bottom Right
*--               cMess1  =  First line of Message
*--               cMess2  =  Second line of message (may be nul = "")
*--               cMess3  =  Third line of message  (may be nul = "")
*--               cColor  =  Colors for window/menu/box
*-----------------------------------------------------------------------

   parameter lAnswer,cWhere,cMess1,cMess2,cMess3,cColor
   private cExact,cW1,cW2,nULB,nBRR,nULC,nBRC

   cExact = set("EXACT")
   save screen to sYesno

   *-- see what the user gave us ...
   if len(trim(m->cWhere)) > 0
      m->cW1 = upper(left(m->cWhere,1))  && first coordinate (vertical)
      m->cW2 = upper(right(m->cWhere,1)) && second coordinate (horiz.)
   else
      m->cW1 = "C"
      m->cW2 = "C"
   endif
   *-- deal with vertical placement
   do case
      case m->cW1 = "U"
         m->nULR =  1   && upper left row
         m->nBRR =  8   && bottom right row
      case m->cW1 = "C"
         m->nULR =  8
         m->nBRR = 15
      case m->cW1 = "B"
         m->nULR = 15
         m->nBRR = 22
   endcase
   *-- deal with horizontal placement
   do case
      case m->cW2 = "L"
         m->nULC =  5   && upper left column
         m->nBRC = 45   && bottom right column
      case m->cW2 = "R"
         m->nULC = 35
         m->nBRC = 75
      case m->cW2 = "C"
         m->nULC = 20
         m->nBRC = 60
   endcase

   activate screen
   define window wYesno from m->nULR,m->nULC to m->nBRR,m->nBRC;
                        double color &cColor.

   define menu mYesno
   *-- remove && from MESSAGE option if using or might be used on
   *-- Mono system
   define pad pYes of mYesno Prompt "[Yes]" at 5,10 && message "Yes"
   define pad pNo  of mYesno Prompt "[No]"  at 5,25 && message "No"
   on selection pad pYes of mYesno deactivate menu
   on selection pad pNo  of mYesno deactivate menu
   *-- start displaying it ... shadow, window ...
   do shadow with m->nULR,m->nULC,m->nBRR,m->nBRC
   activate window wYesno

   *-- display text
   do center with 0,38,"",m->cMess1           && center the text
   do center with 2,38,"",m->cMess2
   do center with 3,38,"",m->cMess3
   *-- set 'y' or 'n' keys ...
   on key label Y keyboard IIF( PAD() = "PYES", "", CHR(19) )+chr(13)
   on key label N keyboard IIF( PAD() = "PNO",  "", CHR(4)  )+chr(13)
   clear typeahead
   if m->lAnswer
      activate menu mYesno pad pYes
   else
      activate menu mYesno pad pNo
   endif

   *-- reset system ...
   on key label Y
   on key label N
   release window wYesno
   restore screen from sYesno
   release screen sYesno
   release menu mYesno
   set exact &cExact

RETURN iif(pad()="PYES",.t.,.f.)
*-- EoF: YesNo2()

FUNCTION YesNo3
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 01/06/1993
*-- Notes.......: A version of the YESNO() routines in PROC.PRG, that
*--               will handle a long (up to 254 character) message
*--               string, is centered on the screen, and has a title
*--               bar kind of like a Windows dialog box ...
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 01/06/1993 -- Original
*-- Calls.......: Center               Procedure in PROC.PRG
*--               Shadow               Procedure in PROC.PRG
*--               WordWrap             Procedure in STRINGS.PRG
*--               ColorBrk()           Function in PROC.PRG
*--               FBClrBrk()           Function in PROC.PRG
*--               Justify()            Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: YesNo3(<lDefault>,<cTitle>,<cMessage>,<cColor>)
*-- Example.....: if YesNo3(.t.,"Test","This is a message of any "+;
*--                         "length up to 254 characters.",cWind1)
*-- Returns.....: logical
*-- Parameters..: lDefault  = Logical value, for the default menu pad
*--                           (Yes/No)
*--               cTitle    = Title for title bar -- no longer than 30
*--                           characters.
*--               cMessage  = Message - up to 254 characters in length.
*--               cColor    = "Standard" colors for window/menu/box
*-----------------------------------------------------------------------

   parameters lDefault, cTitle, cMessage, cColor
   private nULRow, nULCol, nBRRow, nBRCol

   *-- save it, so we can activate the screen and display a window on
   *-- top of whatever's there
   save screen to sYesNo

   *-- save window if there is one, and activate screen to be safe:
   wWindow = window()
   activate screen

   *-- now to define the coordinates ...
   m->nULCol = 20   && left side of box
   m->nBRCol = 60   && right side of box

   m->nWidth =  36  && width of dialog box ... 36 characters for text
   m->nHeight = int(len(m->cMessage)/m->nWidth)
   *-- if the remainder of the length of the message/width of box is > 0
   *-- we have one more line of text ...
   m->nHeight = m->nHeight + iif(mod(len(m->cMessage),m->nWidth)>0,1,0)

   *-- deal with room for title, and menu at bottom
   m->nHeight = m->nHeight + 4

   *-- row coordinates
   m->nULRow = (24-m->nHeight) / 2     && top row
   m->nBRRow = m->nULRow + m->nHeight + 1

   *-- define the window
   define window wYesNo from m->nULRow,m->nULCol to m->nBRRow,m->nBRCol;
                                                double color &cColor.

   *-- now for the menu pads
   define menu mYesNo
   define pad pYes of mYesNo prompt "[Yes]" at m->nHeight - 1,10
   define pad pNo  of mYesNo prompt "[No]"  at m->nHeight - 1,25
   on selection pad pYes of mYesNo deactivate menu
   on selection pad pNo  of mYesNo deactivate menu

   *-- display it
   do shadow with m->nULRow,m->nULCol,m->nBRRow,m->nBRCol
   activate window wYesNo

   *-- display title
   if len(cTitle) < m->nWidth
      m->cTitle = justify(m->cTitle,39,"C")
      if len(m->cTitle) < 39
         m->cTitle = m->cTitle + " "
      endif
   endif
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF  = FBClrBrk("B",m->cTempCol)
   m->cColorB  = FBClrBrk("B",colorbrk(m->cColor,1))
   m->cColorAll = m->cColorF + "/" + m->cColorB
   @0,0 say m->cTitle color &cTempCol.
   @1,0 say replicate(chr(223),39) color &cColorAll.

   *-- display message
   do WordWrap with 2,2,m->cMessage,35

   *-- set Y/N keys for menu pad
   clear typeahead && just to be safe
   on key label Y keyboard iif(pad() = "PYES","",chr(19))+chr(13)
   on key label N keyboard iif(pad() = "PNO", "",chr(4) )+chr(13)

   *-- activate the menu
   if m->lDefault
      activate menu mYesNo pad pYes
   else
      activate menu mYesNo pad pNo
   endif

   *-- reset system
   on key label Y
   on key label N
   release window wYesNo
   restore screen from sYesNo
   release screen sYesNo
   release menu mYesNo
   if .not. isblank(m->wWindow)
      activate window &wWindow.
   endif

RETURN iif(pad() = "PYES",.t.,.f.)
*-- EoF: YesNo3()

FUNCTION YesNo4
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 03/15/1993
*-- Notes.......: Asks a yes/no question in a dialog window/box
*--               Made to look 3-D, removed COLOR parameter, so we could
*--               do this with Borland's STEEL GREY look ... (and it
*--               works with other colors ...)
*--               WARNING: If it matters to you -- this dialog box is 2
*--               columns wider, and two rows taller than previous
*--               versions.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer to become a
*--                            function
*--               04/29/1991 - Modified by Ken Mayer add shadow
*--               05/13/1991 - Modified by Ken Mayer remove need for
*--                            extra procedures (YES/NO) that were
*--                            used for returning values from Menu
*--                            (suggested by Clinton L. Warren (VBCES))
*--               11/15/1991 - Copied YesNo, modified to allow
*--                            "location" options -- useful for some
*--                            screens ...
*--               01/20/1992 - Modified by Martin Leon (HMAN) to allow
*--                            user to press 'Y' or 'N' and have them
*--                            recognized ...
*--               04/22/1992 - Modified by Ken Mayer adding CLEAR
*--                            TYPEAHEAD, as occaisional problems appear
*--                            otherwise.
*--               06/08/1992 - Modified by same for explicit color sets.
*--               03/15/1993 - Modified to look 3-D by playing with
*--                            borders.
*--                            (I got the idea from the Compiler flier)
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*--               BORD3D               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: YesNo4(<lAnswer>,"<cWhere>",;
*--                                "<cMess1>","<cMess2>","<cMess3>",;
*--                                <cColor> [,<nStyle>])
*-- Example.....: if YesNo4(.t.,"UL","Do You Really Wish To Delete?",;
*--                            "This will destroy the data";
*--                            "in this record.","rg+/gb,w+/n,rg+/gb",1)
*--                  delete
*--               else
*--                  skip
*--               endif
*--
*--                 The middle set of colors should be different, as
*--                 they will be the colors of the YES/NO selections
*--                 Options may be blank by using nul values ("")
*-- Returns.....: .t./.f. depending on user's choice from menu
*-- Parameters..: lAnswer  = default value (Yes or No) for menu
*--               cWhere   = location on screen:
*--                             "UL" = Upper Left
*--                             "UC" = Upper Center
*--                             "UR" = Upper Right
*--                             "CL" = Center Left
*--                             "CC" = Center Center
*--                             "CR" = Center Right
*--                             "BL" = Bottom Left
*--                             "BC" = Bottom Center
*--                             "BR" = Bottom Right
*--               cMess1   =  First line of Message
*--               cMess2   =  Second line of message (may be nul = "")
*--               cMess3   =  Third line of message  (may be nul = "")
*--               cColor   =  Colors: forg/back,forg/back,forg/back
*--                           where the first set is window/text color,
*--                           next is highlighted pad color,
*--                           last is border color
*--               nStyle   =  Optional -- 1 = raised 3-d Border,
*--                                       2 = inset 3-d Border
*--                     (Note that this is passed directly to BORD3D)
*-----------------------------------------------------------------------

   parameter lAnswer,cWhere,cMess1,cMess2,cMess3,cColor,nStyle
   private cExact,cW1,cW2,nULB,nBRR,nULC,nBRC

   cExact = set("EXACT")
   cWindow = window()     && save "window" name if there is one active
   save screen to sYesno

   *-- see what the user gave us ...
   if len(trim(m->cWhere)) > 0
      m->cW1 = upper(left(m->cWhere,1))  && first coordinate (vertical)
      m->cW2 = upper(right(m->cWhere,1)) && second coordinate (horiz.)
   else
      m->cW1 = "C"
      m->cW2 = "C"
   endif
   *-- deal with vertical placement
   do case
      case m->cW1 = "U"
         m->nULR =  1   && upper left row
         m->nBRR =  10   && bottom right row
      case m->cW1 = "C"
         m->nULR =  7
         m->nBRR = 16
      case m->cW1 = "B"
         m->nULR = 13
         m->nBRR = 22
   endcase
   *-- deal with horizontal placement
   do case
      case m->cW2 = "L"
         m->nULC =  5   && upper left column
         m->nBRC = 45   && bottom right column
      case m->cW2 = "R"
         m->nULC = 35
         m->nBRC = 75
      case m->cW2 = "C"
         m->nULC = 20
         m->nBRC = 60
   endcase

   activate screen
   define window wYesno from m->nULR,m->nULC to m->nBRR,m->nBRC;
                                              NONE color &cColor.

   define menu mYesno
   define pad pYes of mYesno Prompt "[Yes]" at 7,12
   define pad pNo  of mYesno Prompt "[No]"  at 7,27
   on selection pad pYes of mYesno deactivate menu
   on selection pad pNo  of mYesno deactivate menu

   *-- start displaying it ... shadow, window ...
   do shadow with m->nULR,m->nULC,m->nBRR,m->nBRC
   activate window wYesno

   *-- do 3d border ...
   if pCount() < 7     && if optional parm not passed, set default
      m->nStyle = 1    &&   which is the 'raised' border
   endif
   do bord3d with 9,40,m->cColor,m->nStyle

   *-- display text
   do center with 2,40,"",left(m->cMess1,34)   && center the text
   do center with 4,40,"",left(m->cMess2,34)
   do center with 5,40,"",left(m->cMess3,34)
   *-- set 'y' or 'n' keys ...
   on key label Y keyboard IIF( PAD() = "PYES", "", CHR(19) )+chr(13)
   on key label N keyboard IIF( PAD() = "PNO",  "", CHR(4)  )+chr(13)
   clear typeahead
   if m->lAnswer
      activate menu mYesno pad pYes
   else
      activate menu mYesno pad pNo
   endif

   *-- reset system ...
   on key label Y
   on key label N
   release window wYesno
   restore screen from sYesno
   release screen sYesno
   release menu mYesno
   if .not. isblank(cWindow)
      activate window &cWindow.
   endif
   set exact &cExact.

RETURN iif(pad()="PYES",.t.,.f.)
*-- EoF: YesNo4()

FUNCTION YesNo5
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 03/16/1993
*-- Notes.......: A version of the YESNO() routines in DIALOGS.PRG,
*--               that will handle a long (up to 254 character) message
*--               string, is centered on the screen, and has a title
*--               bar kind of like a Windows dialog box ... (This
*--               version is a modification YESNO3() with a "3-D Border"
*--               added to it ...)
*--               WARNING: This dialog box is two rows taller and two
*--               columns wider than previous versions.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 01/06/1993 -- Original
*--               03/16/1993 -- Added 3-D border
*-- Calls.......: Center               Procedure in PROC.PRG
*--               Shadow               Procedure in PROC.PRG
*--               WordWrap             Procedure in STRINGS.PRG
*--               ColorBrk()           Function in PROC.PRG
*--               FBClrBrk()           Function in PROC.PRG
*--               Justify()            Function in PROC.PRG
*--               Bord3D               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: YesNo5(<lDefault>,<cTitle>,<cMessage>,<cColor>;
*--                      [,<nStyle>])
*-- Example.....: if YesNo5(.t.,"Test","This is a message of any "+;
*--                             "length up to 254 characters.",cWind1,2)
*-- Returns.....: logical
*-- Parameters..: lDefault  = Logical value, for the default menu pad
*--                           (Yes/No)
*--               cTitle    = Title for title bar -- no longer than 30
*--                           characters.
*--               cMessage  = Message - up to 254 characters in length.
*--               cColor    = "Standard" colors for window/menu/box
*--               nStyle    = Optional: nStyle = 1 means raised border
*--                                     nStyle = 2 means inset border
*----------------------------------------------------------------------

   parameters lDefault, cTitle, cMessage, cColor, nStyle
   private nULRow, nULCol, nBRRow, nBRCol, m->nLMargin, nRMargin, lWrap

   if pCount() < 5
      m->nStyle = 1
   endif

   *-- save it, so we can activate the screen and display a window on
   *-- top of whatever's there
   save screen to sYesNo

   *-- save window if there is one, and activate screen to be safe:
   wWindow = window()
   activate screen

   *-- now to define the coordinates ...
   m->nULCol = 20   && left side of box
   m->nBRCol = 60   && right side of box

   m->nWidth =  36  && width of dialog box ... 36 characters for text
   m->nHeight = int(len(m->cMessage)/m->nWidth)
   *-- if the remainder of the length of the message/width of box is > 0
   *-- we have one more line of text ...
   m->nHeight = m->nHeight + iif(mod(len(m->cMessage),m->nWidth)>0,1,0)

   *-- deal with room for title, and menu at bottom (and 3-D Border)
   m->nHeight = m->nHeight + 8

   *-- row coordinates
   m->nULRow = (24-m->nHeight) / 2     && top row
   m->nBRRow = m->nULRow + m->nHeight

   *-- define the window
   define window wYesNo from m->nULRow,m->nULCol to m->nBRRow,m->nBRCol;
                                  NONE color &cColor.

   *-- now for the menu pads
   define menu mYesNo
   define pad pYes of mYesNo prompt "[Yes]" at m->nHeight - 2,10
   define pad pNo  of mYesNo prompt "[No]"  at m->nHeight - 2,25
   on selection pad pYes of mYesNo deactivate menu
   on selection pad pNo  of mYesNo deactivate menu

   *-- display it
   do shadow with m->nULRow,m->nULCol,m->nBRRow,m->nBRCol
   activate window wYesNo

   *-- put 3-D border on it
   do Bord3D with m->nHeight,m->nWidth+4,m->cColor,m->nStyle

   *-- display title
   if len(m->cTitle) < m->nWidth
      m->cTitle = justify(m->cTitle,35,"C")
      if len(m->cTitle) < 35
         m->cTitle = m->cTitle + " "
      endif
   endif
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF  = FBClrBrk("B",cTempCol)
   m->cColorB  = FBClrBrk("B",colorbrk(m->cColor,1))
   m->cColorAll = m->cColorF + "/" + m->cColorB
   @2,3 say m->cTitle color &cTempCol.
   @3,3 say replicate(chr(223),35) color &cColorAll.

   *-- display message
   do WordWrap with 4,4,m->cMessage,34

   *-- set Y/N keys for menu pad
   clear typeahead && just to be safe
   on key label Y keyboard iif(pad() = "PYES","",chr(19))+chr(13)
   on key label N keyboard iif(pad() = "PNO", "",chr(4) )+chr(13)

   *-- activate the menu
   if m->lDefault
      activate menu mYesNo pad pYes
   else
      activate menu mYesNo pad pNo
   endif

   *-- reset system
   on key label Y
   on key label N
   deactivate window wYesNo
   release window wYesNo
   restore screen from sYesNo
   release screen sYesNo
   release menu mYesNo
   if .not. isblank(m->wWindow)
      activate window &wWindow.
   endif

RETURN iif(pad() = "PYES",.t.,.f.)
*-- EoF: YesNo5()

FUNCTION YesNo6
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 06/11/1993
*-- Notes.......: This is a combination of the "best" of YESNO4() and
*--               YESNO5() (I hope). The work involved is based on work
*--               by Miriam Liskin, Martin Leon, Clinton Warren,
*--               Joey D. Carol, and myself.
*--               This Yes/No dialog box should do the following:
*--               A) Full 3-D effect(s)
*--               B) Color options up to programmer/user
*--               C) YES/NO buttons at bottom of dialog box
*--               D) Allow for location on screen
*--               E) Allow for up to 256 characters of text in message
*--               F) Give a "windows" like title bar
*--               G) Allow for screens bigger'n 25 lines ... (EGA43,
*--                  VGA50 ...)
*-- Written for.: dBASE IV, 1.5 or later
*-- Rev. History: 06/11/1993 -- Original
*-- Calls.......: Shadow
*--               Center
*--               Bord3D5
*--               WordWrap
*--               ColorBrk()
*--               FBClrBrk()
*--               Justify()
*-- Called by...: Any
*-- Usage.......: x=YesNo6(<lDefault>,<cWhere>,<cTitle>,<cMessage>,;
*--                        [<cColor>,[<nStyle>]])
*-- Example.....: if YesNo6(.t.,"CC","Delete Record?",;
*--                         "If you select [Yes] "+;
*--                         "you will delete this record.",cWind1,3)
*-- Returns.....: logical
*-- Parameters..: lDefault = Which menu pad do you wish to default to?
*--                          .T. = "Yes", .F. = "No"
*--               cWhere   = Where on the screen do you wish the dialog
*--                          box to appear?
*--                          UL = Upper Left
*--                          UC = Upper Center
*--                          UR = Upper Right
*--                          CL = Center Left
*--                          CC = Center Center (default)
*--                          CR = Center Right
*--                          BL = Bottom Left
*--                          BC = Bottom Center
*--                          BR = Bottom Right
*--               cTitle   = Title for the title bar, up to 30 char.
*--               cMessage = Message, up to 254 characters
*--               cColor   = Colors in standard foreground/background
*--                          If no colors given, you will get the
*--                          Borland "steel grey", with black text.
*--                          The(active) buttons and title bar will end
*--                          up bright white on black.
*--               nStyle   = Border Style
*--                          1 = Double Border, raised (default)
*--                          2 = Double Border, recessed
*--                          3 = Single Border, raised
*--                          4 = Single Border, recessed
*-----------------------------------------------------------------------

   parameters lDefault, cWhere, cTitle, cMessage, cColor, nStyle
   private nParm,nWidth,nHeight,cRow,cCol,nTop,nBottom,nLeft,nRight,;
           cTempCol
   private nBordCol,nButtonRow,cWindow,cScreen,nScreen

   *-- save current screen, save current window
   cWindow = window()
   save screen to sYesNo

   *-- determine # of parameters passed, and set defaults if necessary
   nParm = pcount()
   if nParm < 6          && no selection for border-style, set to def.
      m->nStyle = 1
   endif
   if m->nStyle < 1 .or. m->nStyle > 4  && don't screw with routine!
      m->nStyle = 1
   endif
   if nParm < 5                   && no colors parm, set to steel-grey
      m->cColor = "N/W,W+/N,N/W"
   endif
   if isblank(m->cColor)          && color field is empty, steel-grey
      m->cColor = "N/W,W+/N,N/W"
   endif
   if isblank(m->cWhere)         && default location is center of screen
      m->cWhere = "CC"
   endif

   m->nWidth = 36 + iif(m->nStyle < 3,4,2)    && width of dialog box

   *-- determine height of window by text
   *-- if the remainder of the length of the message/width is > 0
   *--    we have one more line of text, add 1, else add 0
   *-- border will determine more ... (if it's 1 or 2, it's double-size,
   *--    so we add 4 lines (top/bottom * 2), if it's 3 or 4, it's
   *---   single ...)
   *-- add 2 rows for the title, and 3 for the menu, and 1 for the
   *-- button borders ...
   m->nHeight = int(len(m->cMessage)/m->nWidth) + ;
                iif(mod(len(m->cMessage),m->nWidth) > 0,1,0) +;
                iif(m->nStyle < 3,3,1) + 6

   *-- now to determine window Coordinates
   m->cRow = left(m->cWhere,1)
   m->cCol = right(m->cWhere,1)

   *-- get screen height
   m->cScreen = SET("DISPLAY")
   if m->cScreen = "MONO"
      m->nScreen = 24
   else
      m->nScreen = val(right(m->cScreen,2)) - 1  && (EGA25 = 0 to 24)
   endif

   *-- this is where we _really_ determine the coordinates
   do case   && first let's get the rows (top/bottom)
      case m->cRow = "U"
         m->nTop = 1
      case m->cRow ="B"
         m->nTop = (m->nScreen - m->nHeight - 2)
      otherwise  && "C" or center ...
         m->nTop = (m->nScreen - m->nHeight) / 2
   endcase
   m->nBottom = m->nTop + m->nHeight

   do case   && now for the columns
      case m->cCol = "L"
         m->nLeft = 5
      case m->cCol = "R"
         m->nLeft = 35
      otherwise && "C" or center
         m->nLeft = 20
   endcase
   m->nRight = m->nLeft + m->nWidth

   *-- define window
   activate screen
   define window wYesNo from m->nTop,m->nLeft to ;
                             m->nBottom,m->nRight NONE color &cColor.

   *-- define menu
   define menu mYesNo
   m->nButtonRow = m->nHeight - iif(m->nStyle<3,3,2)
   define pad pYes of mYesNo prompt "[Yes]" at m->nButtonRow,10
   define pad pNo  of mYesNo prompt "[No]"  at m->nButtonRow,25
   on selection pad pYes of mYesNo deactivate menu
   on selection pad pNo  of mYesNo deactivate menu

   *-- activate window
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight
   activate window wYesNo

   *-- draw border
   m->cBordCol = left(m->cColor,at(",",m->cColor)-1)
   do Bord3D5 with 0,0,m->nHeight,m->nWidth,m->cBordCol,m->nStyle

   *-- display title
   if len(m->cTitle) < m->nWidth
      m->cTitle = justify(m->cTitle,35,"C")
      if len(m->cTitle) < 35
         m->cTitle = m->cTitle + " "
      endif
   endif
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF  = FBClrBrk("B",m->cTempCol)
   m->cColorB  = FBClrBrk("B",colorbrk(m->cColor,1))
   m->cColorAll= m->cColorF+"/"+m->cColorB
   m->nRow = iif(m->nStyle < 3,2,1)
   m->nCol = iif(m->nStyle < 3,3,2)
   @m->nRow,  m->nCol say m->cTitle color &cTempCol.
   @m->nRow+1,m->nCol say replicate(chr(223),35) color &cColorAll.

   *-- display text
   do WordWrap with iif(m->nStyle<3,4,3),;
                    iif(m->nStyle<3,4,3),m->cMessage,34

   *-- set Y/N keys for menu pad
   clear typeahead && just to be safe
   on key label Y keyboard iif(pad() = "PYES","",chr(19))+chr(13)
   on key label N keyboard iif(pad() = "PNO" ,"",chr(4) )+chr(13)

   *-- deal with borders around the pads ...
   do bord3d5 with m->nButtonRow-1, 9,m->nButtonRow+1,15,m->cBordCol,3
   do bord3d5 with m->nButtonRow-1,24,m->nButtonRow+1,29,m->cBordCol,3

   *-- activate menu
   if m->lDefault
      activate menu mYesNo pad pYes
   else
      activate menu mYesNo pad pNo
   endif

   *-- cleanup
   on key label Y
   on key label N
   release window wYesNo
   restore screen from sYesNo
   release screen sYesNo
   release menu mYesNo
   if .not. isblank(m->cWindow)
      activate window &cWindow.
   endif

RETURN iif(pad() = "PYES",.T.,.F.)
*-- EoF: YesNo6()

FUNCTION YesNoCan
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 02/01/1993
*-- Notes.......: Asks a yes/no/cancel question in a dialog window/box
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer to become a
*--                            function
*--               04/29/1991 - Modified to Ken Mayer add shadow
*--               05/13/1991 - Modified to Ken Mayer remove need for
*--                            extra procedures (YES/NO) that were used
*--                            for returning values from Menu
*--                            (suggested by Clinton L. Warren (VBCES))
*--               01/20/1992 - Modified by Martin Leon (HMan) to handle
*--                            user pressing 'Y' or 'N' keys (with ON
*--                            KEY ...).
*--               06/11/1992 - Modified by Joey Carroll (JOEY) to allow
*--                            answer choices to be "Yes", "No", or
*--                            "Cancel" or to allow for parameters to
*--                            pass the contents of the prompts. If
*--                            none are passed, they default
*--                            to "Yes", "No", "Cancel". Further
*--                            modified to allow specification of
*--                            location by row if desired. Window size
*--                            now varies as parameters dictate.
*--               09/21/1992 - Modified by JOEY to fix bug caused if
*--                            leading blanks in parameters cPrompt1,
*--                            cPrompt2,cPrompt3
*--                            Corrected example - case pad()="PPAD1"
*--                            instead of          case pad()=PPAD1
*--               02/01/1993 - Mods by Lee Hite: Routine would not wait
*--                            for user response if "default" answer
*--                            did not match one of the prompts. Now
*--                            first prompt becomes default if no match
*--                            is found on invocation. Also, match is
*--                            no longer case sensitive.  Also made
*--                            window height variable if message
*--                            lines 2 and/or 3 are null strings.
*--                            Finally, added "confirmation" parameter
*--                            which when set true will force user to
*--                            press [Enter] before function returns.
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*--               ISBLANK()            Function in MISC.PRG,
*--                                                    Internal in 1.5
*-- Called by...: Any
*-- Usage.......: YesNoCan("<cAnswer>","<cMess1>","<cMess2>",;
*--                        ["<cMess3>",;["<cPrompt1>",["<cPrompt2>",;
*--                        ["<cPrompt3>",[<nTopRow>,["<cColor>",;
*--                        [lConfirm]]]]]]])
*-- Example.....: cAnswer="Y"
*--               cAnswer=YesNoCan(cAnswer,"*** Warning ***",;
*--                            "A serious error has occured.",;
*--                             "Choose carefully.","Proceed",;
*--                             "Retry","Cancel",10,;
*--                             "w+/r,n/w,w+/r")
*--               do case
*--                  case cAnswer="Y"    && OR case pad()="PPAD1"
*--                     * do your thing
*--                  case cAnswer="N"    && OR case pad()="PPAD2"
*--                     skip
*--                  case cAnswer="C"    && OR case pad()="PPAD3"
*--                     * e.g. - return
*--               endcase
*--
*--                 The middle set of colors should be different, as
*--                 they will be the colors of the YES/NO selections
*--                 Options may be blank by using nul values ("")
*-- Returns.....: First character of selected pad
*-- Parameters..: cAnswer  =  default value (Yes or No or Cancel) for
*--                           menu
*--               cMess1   =  First line of Message
*--               cMess2   =  Second line of message
*--               cMess3   =  Third line of message
*--               cPrompt1 =  Optional prompt for left pad
*--               cPrompt2 =  Optional prompt for middle pad
*--               cPrompt3 =  Optional prompt for right pad
*--               nTopRow  =  Optional top row of window
*--               cColor   =  Optional colors for window/menu/box
*--               lConfirm =  Optional "confirmation" parameter -- if
*--                           true user must press [Enter], otherwise
*--                           pressing a valid prompt key automatically
*--                           returns
*-----------------------------------------------------------------------

   parameter cAnswer,cMess1,cMess2,cMess3,;
      cPrompt1,cPrompt2,cPrompt3,nTopRow,cColor,lConfirm
   private nLMargin,nRMargin,lWrap,nTopRowMax,cKey1,cKey2,cKey3,;
      nWinWidth, cConfirm, nWinHgth, nMsgRow
   private cPrompt1,cPrompt2,cPrompt3

   *-- save screen so we can restore ...
   save screen to sYesNoCan
   * locate top row of window
   m->nTopRowMax = iif(set("STATUS") = "OFF",17,14)
                                           && protect Status Line
   m->nTopRow = iif(isblank(m->nTopRow),14,m->nTopRow)
                                           && no parameter passed
   m->nTopRow = min(m->nTopRowMax,m->nTopRow)

   * set pad prompts if none passed
   m->cPrompt1 = iif(isblank(m->cPrompt1),"Yes",m->cPrompt1)
   m->cPrompt2 = iif(isblank(m->cPrompt2),"No",m->cPrompt2)
   m->cPrompt3 = iif(isblank(m->cPrompt3),"Cancel",m->cPrompt3)
   m->cAnswer = iif(isblank(m->cAnswer),m->cPrompt1,m->cAnswer)

   * program bombs if prompts passed contain leading blanks
   m->cPrompt1 = ltrim(trim(m->cPrompt1))
   m->cPrompt2 = ltrim(trim(m->cPrompt2))
   m->cPrompt3 = ltrim(trim(m->cPrompt3))

   * determine how wide the window needs to be
   m->nWinWidth = max(19,len(m->cPrompt1 + m->cPrompt2 + ;
                                           m->cPrompt3) +13)
   m->nWinWidth = max(m->nWinWidth,len(m->cMess1)+4)
   m->nWinWidth = max(m->nWinWidth,len(m->cMess2)+4)
   m->nWinWidth = max(m->nWinWidth,len(m->cMess3)+4)
   * and how high it needs to be
   m->nWinHgth = iif(""=m->cMess2,7,8)
   m->nWinHgth = iif(""=m->cMess3,m->nWinHgth-1,m->nWinHgth)
   * and center it
   define window wYesNoCan from m->nTopRow,40-(m->nWinWidth+2)/2 ;
      to m->nTopRow+m->nWinHgth-1,40+(m->nWinWidth+2)/2 double ;
      color &cColor.
   define menu mYesNoCan
   define pad pPad1 of mYesNoCan Prompt "["+m->cPrompt1+"]" ;
      at m->nWinHgth-3,02
   * center middle prompt between other two, not center of window
   define pad pPad2 of mYesNoCan Prompt "["+m->cPrompt2+"]" at ;
      m->nWinHgth-3, ((m->nWinWidth-len(m->cPrompt2))/2+;
      (len(m->cPrompt1)-len(m->cPrompt3))/2)
   define pad pPad3 of mYesNoCan Prompt "["+m->cPrompt3+"]"  ;
      at m->nWinHgth-3,(m->nWinWidth-3)-(len(m->cPrompt3))
   on selection pad pPad1 of mYesNoCan deactivate menu
   on selection pad pPad2 of mYesNoCan deactivate menu
   on selection pad pPad3 of mYesNoCan deactivate menu

   activate screen
   do shadow with m->nTopRow,40-(m->nWinWidth+2)/2,m->nTopRow+;
      m->nWinHgth-1, 40+(m->nWinWidth+2)/2
   activate window wYesNoCan

   do center with 0,m->nWinWidth,"",m->cMess1       && center the text
   *-- deal with blank message lines
   m->nMsgRow = 2
   if "" <> m->cMess2
      do center with m->nMsgRow,m->nWinWidth,"",m->cMess2
      m->nMsgRow = m->nMsgRow + 1
   endif
   if "" <> m->cMess3
      do center with m->nMsgRow,m->nWinWidth,"",m->cMess3
   endif
   *-- deal with user pressing first key of prompt
   m->cKey1 = left(m->cPrompt1,1)
   m->cKey2 = left(m->cPrompt2,1)
   m->cKey3 = left(m->cPrompt3,1)
   *-- set [CR] at end of keyboard command depending on "confirm"
   *-- parameter
   m->cConfirm = iif(m->lConfirm,"",chr(13))

   on key label &cKey1. keyboard iif( PAD() = "PPAD1", "", ;
      iif(pad() = "PPAD2", chr(19),CHR(4) )) + m->cConfirm
   on key label &cKey2. keyboard iif( PAD() = "PPAD2",  "", ;
      iif(pad() = "PPAD1",CHR(4),chr(19) )) + m->cConfirm
   on key label &cKey3. keyboard iif( PAD() = "PPAD3", "", ;
      iif(pad() = "PPAD2", CHR(4),chr(19))) + m->cConfirm
   clear typeahead
   *-- otherwise deal with regular "menu" abilities
   do case
      case upper(m->cAnswer)=upper(m->cKey1)
           activate menu mYesNoCan pad pPad1
      case upper(m->cAnswer)=upper(m->cKey2)
           activate menu mYesNoCan pad pPad2
      case upper(m->cAnswer)=upper(m->cKey3)
           activate menu mYesNoCan pad pPad3
      otherwise
           activate menu mYesNoCan pad pPad1
   endcase

   *-- clear out ON KEY settings ...
   on key label &cKey1.
   on key label &cKey2.
   on key label &cKey3.
   *-- reset environment
   release window wYesNoCan
   restore screen from sYesNoCan
   release screen sYesNoCan
   release menu mYesNoCan

RETURN upper(substr(prompt(),2,1))
*-- EoF: YesNoCan()

FUNCTION YNC
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 06/24/1993
*-- Notes.......: This is a variation of YESNO(), designed to allow the
*--               programmer to give the user three buttons, instead of
*--               two -- "Yes", "No" and "Cancel". The one MAJOR
*--               difference is the logical parameter "lDefault" must
*--               be changed to character, and the returned value will
*--               also be character. The work involved is based on work
*--               by Miriam Liskin, Martin Leon, Clinton Warren,
*--               Joey D. Carol, and myself.
*--               This Yes/No dialog box should do the following:
*--               A) Full 3-D effect(s)
*--               B) Color options up to programmer/user
*--               C) YES/NO buttons at bottom of dialog box
*--               D) Allow for location on screen
*--               E) Allow for up to 256 characters of text in message
*--               F) Give a "windows" like title bar
*--               G) Allow for screens bigger'n 25 lines ... (EGA43,
*--                  VGA50 ...)
*-- Written for.: dBASE IV, 1.5 or later
*-- Rev. History: 06/24/1993 -- Original
*-- Calls.......: Shadow              Procedure in PROC.PRG
*--               Center              Procedure in PROC.PRG
*--               Bord3D              Procedure in PROC.PRG
*--               WordWrap            Procedure in PROC.PRG
*--               ColorBrk()          Function in PROC.PRG
*--               FBClrBrk()          Function in PROC.PRG
*--               Justify()           Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: x=YNC(<cDefault>,<cWhere>,<cTitle>,<cMessage>,;
*--                     [<cColor>,[<nStyle>]])
*-- Example.....: x= YNC("Y","CC","Delete Record?",;
*--                               "If you select [Yes] "+;
*--                         "you will delete this record.",cWind1,3)
*--               do case
*--                  case x = "Y"
*--                       * do "Yes" action
*--                  case x = "N:
*--                       * do "No" action
*--                  otherwise
*--                       *-- do "Cancel" action
*--               endcase
*-- Returns.....: Character (first char of button)
*-- Parameters..: cDefault = Which menu pad do you wish to default to?
*--                          "Y" = "Yes", "N" = "No", "C" = "Cancel"
*--               cWhere   = Where on the screen do you wish the dialog
*--                          box to appear?
*--                          UL = Upper Left
*--                          UC = Upper Center
*--                          UR = Upper Right
*--                          CL = Center Left
*--                          CC = Center Center (default)
*--                          CR = Center Right
*--                          BL = Bottom Left
*--                          BC = Bottom Center
*--                          BR = Bottom Right
*--               cTitle   = Title for the title bar, up to 30
*--                          characters
*--               cMessage = Message, up to 254 characters
*--               cColor   = Colors in standard foreground/background
*--                          If no colors given, you will get the
*--                          Borland "steel grey", with black text. The
*--                          (active) buttons and title bar will end up
*--                          bright white on black.
*--               nStyle   = Border Style
*--                          1 = Double Border, raised (default)
*--                          2 = Double Border, recessed
*--                          3 = Single Border, raised
*--                          4 = Single Border, recessed
*-----------------------------------------------------------------------

   parameters cDefault, cWhere, cTitle, cMessage, cColor, nStyle
   private nParm,nWidth,nHeight,cRow,cCol,nTop,nBottom,nLeft,nRight,;
           cTempCol
   private nBordCol,nButtonRow,cWindow,cScreen,nScreen

   *-- save current screen, save current window
   cWindow = window()
   save screen to sYesNo

   *-- determine # of parameters passed, and set defaults if necessary
   m->nParm = pcount()
   if m->nParm < 6            && no selection for border-style, set to def.
      m->nStyle = 1
   endif
   if m->nStyle < 1 .or. m->nStyle > 4  && don't screw with my routine!
      m->nStyle = 1
   endif
   if m->nParm < 5                   && no colors, set to steel-grey
      m->cColor = "N/W,W+/N,N/W"
   endif
   if isblank(m->cColor)
      m->cColor = "N/W,W+/N,N/W"
   endif
   if isblank(m->cWhere)         && default location is center of screen
      m->cWhere = "CC"
   endif

   *-- set some defaults
   m->nWidth = 36 + iif(m->nStyle < 3,4,2)    && width of dialog box

   *-- determine height of window by text
   *-- if the remainder of the length of the message/width is > 0
   *--    we have one more line of text, add 1, else add 0
   *-- border will determine more ... (if it's 1 or 2, it's double-size,
   *--    so we add 4 lines (top/bottom * 2), if it's 3 or 4, it's
   *--    single ...)
   *-- add 2 rows for the title, and 3 for the menu, and 1 for the
   *-- button borders ...
   m->nHeight = int(len(m->cMessage)/m->nWidth) + ;
             iif(mod(len(m->cMessage),m->nWidth) > 0,1,0) +;
             iif(m->nStyle < 3,3,1) + 6

   *-- now to determine window Coordinates
   m->cRow = left(m->cWhere,1)
   m->cCol = right(m->cWhere,1)

   *-- get screen height
   m->cScreen = SET("DISPLAY")
   if m->cScreen = "MONO"
      m->nScreen = 24
   else
      m->nScreen = val(right(m->cScreen,2)) - 1  && (EGA25 = 0 to 24)
   endif

   *-- this is where we _really_ determine the coordinates
   do case   && first let's get the rows (top/bottom)
      case m->cRow = "U"
         m->nTop = 1
      case m->cRow ="B"
         m->nTop = (m->nScreen - m->nHeight - 2)
      otherwise  && "C" or center ...
         m->nTop = (m->nScreen - m->nHeight) / 2
   endcase
   m->nBottom = m->nTop + m->nHeight

   do case   && now for the columns
      case m->cCol = "L"
         m->nLeft = 5
      case m->cCol = "R"
         m->nLeft = 35
      otherwise && "C" or center
         m->nLeft = 20
   endcase
   m->nRight = m->nLeft + m->nWidth

   *-- define window
   activate screen
   define window wYesNo from m->nTop,m->nLeft to ;
                             m->nBottom,m->nRight NONE color &cColor.

   *-- define menu
   define menu mYesNo
   m->nButtonRow = m->nHeight - iif(m->nStyle<3,3,2)
   m->nYes = 5             && column for "[Yes]"    button
   m->nNo  = (m->nWidth-6)/2  && column for "[No]"  button -- center it
   m->nCan = (m->nWidth-13)   && column for "[Cancel]" button -- from rt
   define pad pYes of mYesNo prompt "[Yes]"    at m->nButtonRow,m->nYes
   define pad pNo  of mYesNo prompt "[No]"     at m->nButtonRow,m->nNo
   define pad pCan of mYesNo prompt "[Cancel]" at m->nButtonRow,m->nCan
   on selection pad pYes of mYesNo deactivate menu
   on selection pad pNo  of mYesNo deactivate menu
   on selection pad pCan of mYesNo deactivate menu

   *-- activate window
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight
   activate window wYesNo

   *-- draw border
   m->cBordCol = left(m->cColor,at(",",m->cColor)-1)
   do bord3d with 0,0,m->nHeight,m->nWidth,m->cBordCol,m->nStyle

   *-- display title
   if len(m->cTitle) < m->nWidth
      m->cTitle = justify(m->cTitle,35,"C")
      if len(m->cTitle) < 35
         m->cTitle = m->cTitle + " "
      endif
   endif
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF  = FBClrBrk("B",m->cTempCol)
   m->cColorB  = FBClrBrk("B",colorbrk(m->cColor,1))
   m->cColorAll= m->cColorF+"/"+m->cColorB
   m->nRow = iif(m->nStyle < 3,2,1)
   m->nCol = iif(m->nStyle < 3,3,2)
   @m->nRow,  m->nCol say m->cTitle color &cTempCol.
   @m->nRow+1,m->nCol say replicate(chr(223),35) color &cColorAll.

   *-- display text
   do WordWrap with iif(m->nStyle<3,4,3),;
                    iif(m->nStyle<3,4,3),m->cMessage,34

   *-- set Y/N keys for menu pad
   clear typeahead && just to be safe
   *-- if we're ON the pad user selected, do nothing, else go left or
   *-- right as needed, and then issue a "Return" (chr(13))
   on key label Y keyboard iif(pad() = "PYES","",;
      iif(pad()="PNO",chr(19),chr(4) ) )+chr(13)
   on key label N keyboard iif(pad() = "PNO" ,"",;
      iif(pad()="PYES",chr(4),chr(19) ) )+chr(13)
   on key label C keyboard iif(pad() = "PCAN","",;
      iif(pad()="PNO",chr(4),chr(19) ) )+chr(13)

   *-- deal with borders around the pads ...
   do bord3d with m->nButtonRow-1,m->nYes-1,m->nButtonRow+1,;
                  m->nYes+5,m->cBordCol,3
   do bord3d with m->nButtonRow-1,m->nNo-1, m->nButtonRow+1,;
                  m->nNo+4, m->cBordCol,3
   do bord3d with m->nButtonRow-1,m->nCan-1,m->nButtonRow+1,;
                  m->nCan+8,m->cBordCol,3

   *-- activate menu
   do case
      case upper(m->cDefault) = "Y"
         activate menu mYesNo pad pYes
      case upper(m->cDefault) = "N"
         activate menu mYesNo pad pNo
      case (m->cDefault) = "C"
         activate menu mYesNo pad pCan
      otherwise  && default to 'Yes'
         activate menu mYesNo pad pYes
   endcase

   *-- cleanup
   on key label Y
   on key label N
   on key label C
   release window wYesNo
   restore screen from sYesNo
   release screen sYesNo
   release menu mYesNo
   if .not. isblank(m->cWindow)
      activate window &cWindow.
   endif

RETURN substr(pad(),2,1)
*-- EoF: YNC()

FUNCTION Dialog
*-----------------------------------------------------------------------
*-- Programmer..: Larry Quaglia (Borland)
*-- Date........: 06/09/1992
*-- Notes.......: This routine provides a 'standard' set of dialogue
*--               boxes and buttons for all applications. The concept
*--               is to provide standardization for your apps. Taken
*--               from TECHNOTES.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/01/1991 -- first published in TechNotes.
*--               06/09/1992 -- Modified to handle explicit colors,
*--               changed the color parameters a tad ... (Ken Mayer)
*-- Calls.......: SHADOW               Function in PROC.PRG
*--               RECOLOR              Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: Dialog("<cMsg>",<nType>,"<cBorder>",<nDefBut>,;
*--                       <lShadow>,"<cWind>","<cButton>")
*-- Example.....: Dialog("We have completed the transaction.",0,;
*--                      "DOUBLE",0,.t.,"RG+/GB","W+/N")
*-- Returns.....: Character -- Either 'ERROR' or title of Button.
*-- Parameters..: cMsg    = Message to be displayed -- maximum of 78
*--                         characters (one line only)
*--               nType   = Dialogue box TYPE. Options are 0 to 5:
*--                         0:   'OK'
*--                         1: 'OK'  'CANCEL'
*--                         2: 'ABORT'  'RETRY'  'IGNORE'
*--                         3: 'YES'  'NO'  'CANCEL'
*--                         4: 'YES'  'NO'
*--                         5: 'RETRY' 'CANCEL'
*--               cBorder = Border Style -- options are: "" (null) for
*--                         SINGLE, DOUBLE or PANEL.
*--               nDefBut = Default Button.
*--               lShadow = Display with a shadow or not (both on window
*--                         and buttons)?
*--               cWind   = Window Colors (must be valid dBASE color
*--                         combo: i.e., "RG+/GB")
*--               cButton = Highlighted Button Color (Same as above,
*--                         should contrast ...)
*-----------------------------------------------------------------------

   parameters cMsg,nType,cBorder,nDefBut,lShadow,cWind,cButton
   private nMsgLen,cNewColor,aButton,nMaxLine,nY,nBoxLen,nNumButton,;
           nCounter,nBasex,nYCol,nMsgLoc,cCurColor

   save screen to sDialog         && so we can restore at end of routine

   *-- determine length of message
   m->nMsgLen = len(trim(ltrim(m->cMsg))) + 1

   *-- Check for valid parms
   do case
      case m->nMsgLen > 78
         RETURN "ERROR - Message Length"
      case .not. (upper(m->cBorder) = "DOUBLE" .or. upper(m->cBorder)=;
         "PANEL" .or. len(trim(m->cBorder)) = 0)
         RETURN "ERROR - Border"
   endcase

   *-- save current color info and set color to user-defined
   m->cCurColor = set("ATTRIBUTES")
   set color of normal    to &cWind.
   set color of box       to &cWind.
   set color of message   to &cWind.
   set color of highlight to &cButton.

   *-- Allow use of <Tab> to move from button to button
   on key label tab keyboard chr(4)  && act as if right arrow were
                                     && pushed

   *-- Define button array -- max of 3 buttons (at the moment)
   declare aButton[3]
   aButton[1] = ""
   aButton[2] = ""
   aButton[3] = ""

   *-- Establish screen height to properly center dialogue box
   m->nMaxLine = iif(right(set("DISP"),2) = "43",43,24)

   *-- Determine length of passed "message" parameter. If long enough,
   *-- make the dialog box a little bigger. If very short, make it just
   *-- big enough to accomodate the three buttons.
   m->nY = iif(int(m->nMsgLen) > 30,int(m->nMsgLen/2)+2,24)
   m->nBoxLen = 2 * m->nY

   *-- Setup the window and determine if shadow ... if yes, call shadow
   define window wDialog from int(m->nMaxLine/2)-5,40-m->nY to ;
                         int(m->nMaxLine/2)+4,40+m->nY &cBorder.
   if m->lShadow
      activate screen
      do shadow with int(m->nMaxLine/2)-5,40-m->nY,;
                     int(m->nMaxLine/2)+4,40+m->nY
   endif
   activate window wDialog
   clear

   *-- Determine the type of buttons and set appropriate parms.
   *-- These could be modified to your own needs.
   do case
      case m->nType = 0
         m->nNumButton = 1
         aButton[1] = "   OK   "
      case m->nType = 1
         m->nNumButton = 2
         aButton[1] = "   OK   "
         aButton[2] = " CANCEL "
      case m->nType = 2
         m->nNumButton = 3
         aButton[1] = " ABORT  "
         aButton[2] = " RETRY  "
         aButton[3] = " IGNORE "
      case m->nType = 3
         m->nNumButton = 3
         aButton[1] = "   YES  "
         aButton[2] = "   NO   "
         aButton[3] = " CANCEL "
      case m->nType = 4
         m->nNumButton = 2
         aButton[1] = "   YES  "
         aButton[2] = "   NO   "
      case m->nType = 5
         m->nNumButton = 2
         aButton[1] = " RETRY  "
         aButton[2] = " CANCEL "
   endcase

   *-- Get dialog box length to create a bar menu of appropriate size.
   *-- Define the bar menu in a loop. Deactivate it upon selection of
   *-- one of the buttons.
   m->nCounter = 1
   m->nBaseX = m->nBoxLen / (m->nNumButton + 1)
   define menu mDialog
   do while m->nCounter <= m->nNumButton
      pPadName = "PAD"+str(m->nCounter,1)  && pad name is 'PAD #'
      m->nYCol = (m->nCounter * m->nBaseX) - ;
                 (int(len(aButton[m->nCounter]) /2))
      define pad &pPadName of mDialog prompt aButton[m->nCounter] ;
                 at 4,m->nYCol

      *-- If shadow is on, put shadows on buttons as well ...
      if m->lShadow
         activate screen
         do shadow with 3,m->nYCol-2,5,m->nYCol+;
                        (len(aButton[m->nCounter]))-1
      endif
      @3,m->nYCol-1 to 5,m->nYCol+(len(aButton[m->nCounter]))
                                    && box around button
      on selection pad &pPadName. of mDialog deactivate menu
      m->nCounter = m->nCounter + 1
   enddo

   *-- place message (centered in box)
   m->nMsgLoc = int(m->nBoxLen/2) - int(m->nMsgLen/2)
   @1,m->nMsgLoc say m->cMsg

   *-- place cursor to the default button specified by the user
   m->nCounter = 1
   do while m->nCounter < m->nDefBut
      keyboard chr(4)
      m->nCounter = m->nCounter + 1
   enddo

   *-- Activate the whole thing, and return the button name
   activate menu mDialog
   m->cValue = trim(ltrim(prompt()))

   *-- deactivate it all, restore screen, etc.
   release window wDialog
   release menu mDialog
   restore screen from sDialog
   release screen sDialog
   do ReColor with m->cCurColor
   on key label tab

RETURN m->cValue
*-- EoF: Dialog()

FUNCTION DIALOG2
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 06/30/1993
*-- Notes.......: This is a variation of YESNO(), designed to allow the
*--               programmer to give the user up to three buttons,
*--               allowing them to select the ones they want, either by
*--               choosing one of the options listed, or passing as
*--               parameters up to three  selections for button titles.
*-- Written for.: dBASE IV, 1.5 or later
*-- Rev. History: 06/24/1993 -- Original
*-- Calls.......: Shadow              Procedure in PROC.PRG
*--               Center              Procedure in PROC.PRG
*--               Bord3D              Procedure in PROC.PRG
*--               WordWrap            Procedure in PROC.PRG
*--               ColorBrk()          Function in PROC.PRG
*--               FBClrBrk()          Function in PROC.PRG
*--               Justify()           Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: x=DIALOG2(<nType>,<nDefault>,<cWhere>,<cTitle>,;
*--                         <cMessage>,<cColor>,<nStyle>,[<cButton1>,;
*--                         <cButton2>,<cButton3>])
*-- Example.....: x= DIALOG2(1,1,"CC","Delete Record?",;
*--                          "If you select [Yes] "+;
*--                          "you will delete this record.",cWind1,3)
*--               do case
*--                  case x = "O"
*--                       * do "OK" action
*--                  otherwise
*--                       *-- do "Cancel" action
*--               endcase
*-- Returns.....: Character (first char of button)
*-- Parameters..: nType    = Type of dialog box:
*--                          1 = Predefined: "OK  CANCEL"
*--                          2 = Predefined: "ABORT  RETRY  IGNORE"
*--                          3 = Predefined: "RETRY  CANCEL"
*--                           (For options with YES/NO or YES/NO/CANCEL,
*--                           see YESNO() or YNC(); for options with
*--                           "OK", see ALERT())
*--                          4 = User-defined: Button text will depend
*--                              on text in cButton1,cButton2, and
*--                              cButton3.
*--               nDefault = Which menu pad do you wish to default to?
*--                          Number refers to pad 1, 2 or 3.
*--               cWhere   = Where on the screen do you wish the dialog
*--                          box to appear?
*--                          UL = Upper Left
*--                          UC = Upper Center
*--                          UR = Upper Right
*--                          CL = Center Left
*--                          CC = Center Center (default)
*--                          CR = Center Right
*--                          BL = Bottom Left
*--                          BC = Bottom Center
*--                          BR = Bottom Right
*--               cTitle   = Title for the title bar, up to 30
*--                          characters
*--               cMessage = Message, up to 254 characters
*--               cColor   = Colors in standard foreground/background
*--                          If no colors given, you will get the
*--                          Borland "steel grey", with black text.
*--                          The buttons and title bar will end up
*--                          bright white on black.
*--               nStyle   = Border Style
*--                          1 = Double Border, raised (default)
*--                          2 = Double Border, recessed
*--                          3 = Single Border, raised
*--                          4 = Single Border, recessed
*--               cButton1 = Text for first button -- optional (only
*--                          used if nType = 4) -- NOTE: Button text
*--                          should be 6 char or less.
*--               cButton2 = Text for second button (as above)
*--               cButton3 = Text for third button (as above)
*-----------------------------------------------------------------------

   parameters nType, nDefault, cWhere, cTitle, cMessage, cColor, ;
              nStyle, cButton1, cButton2, cButton3
   private nParm,nWidth,nHeight,cRow,cCol,nTop,nBottom,nLeft,nRight,;
           cTempCol
   private nBordCol,nButtonRow,cWindow,cScreen,nScreen,nButtons

   *-- save current screen, save current window
   cWindow = window()
   save screen to sYesNo

   *-- determine # of parameters passed, and set defaults if necessary
   m->nParm = pcount()

   *-- deal with border
   if m->nParm < 7         && no selection for border-style, set to def.
      m->nStyle = 1
   endif
   if m->nStyle = 0
      m->nStyle = 1
   endif
   if m->nStyle < 1 .or. m->nStyle > 4  && don't screw with my routine!
      m->nStyle = 1
   endif

   *-- deal with colors
   if m->nParm < 6                   && no colors, set to steel-grey
      m->cColor = "N/W,W+/N,N/W"
   endif
   if isblank(m->cColor)
      m->cColor = "N/W,W+/N,N/W"
   endif

   *-- location on screen
   if isblank(m->cWhere)        && default location is center of screen
      m->cWhere = "CC"
   endif

   *-- deal with button types ...
   do case  && 1 space on either side of button ...
      case m->nType = 1
         m->nButtons = 2
         m->cButton1 = " OK "
         m->cButton2 = " Cancel "
         m->cButton3 = ""
      case m->nType = 2
         m->nButtons = 3
         m->cButton1 = " Abort "
         m->cButton2 = " Retry "
         m->cButton3 = " Ignore "
      case m->nType = 3
         m->nButtons = 2
         m->cButton1 = " Retry "
         m->cButton2 = " Cancel "
      case m->nType = 4 .and. m->nParm > 8
                                 && must be two buttons or more
         m->nButtons = m->nParm - 7
         m->cButton1 = " "+ltrim(rtrim(m->cButton1))+" "
         m->cButton2 = " "+lTrim(rTrim(m->cButton2))+" "
         if m->nButtons > 2
            m->cButton3 = " "+lTrim(rTrim(m->cButton3))+" "
         endif
      otherwise
         RETURN "ERROR!"
   endcase

   *-- just to be sure ...
   if m->nDefault = 0 .or. m->nDefault > m->nButtons
      m->nDefault = 1
   endif

   *-- set some defaults
   m->nWidth = 36 + iif(m->nStyle < 3,4,2)    && width of dialog box

   *-- determine height of window by text
   *-- if the remainder of the length of the message/width is > 0
   *--    we have one more line of text, add 1, else add 0
   *-- border will determine more ... (if it's 1 or 2, it's double-size,
   *--    so we add 4 lines (top/bottom * 2), if it's 3 or 4, it's
   *--    single ...)
   *-- add 2 rows for the title, and 3 for the menu, and 1 for the
   *-- button borders ...
   m->nHeight = int(len(m->cMessage)/m->nWidth) + ;
             iif(mod(len(m->cMessage),m->nWidth) > 0,1,0) +;
             iif(m->nStyle < 3,3,1) +  6

   *-- now to determine window Coordinates
   m->cRow = left(m->cWhere,1)
   m->cCol = right(m->cWhere,1)

   *-- get screen height
   m->cScreen = SET("DISPLAY")
   if m->cScreen = "MONO"
      m->nScreen = 24
   else
      m->nScreen = val(right(m->cScreen,2)) - 1  && (EGA25 = 0 to 24)
   endif

   *-- this is where we _really_ determine the coordinates
   do case   && first let's get the rows (top/bottom)
      case m->cRow = "U"
         m->nTop = 1
      case m->cRow ="B"
         m->nTop = (m->nScreen - m->nHeight - 2)
      otherwise  && "C" or center ...
         m->nTop = (m->nScreen - m->nHeight) / 2
   endcase
   m->nBottom = m->nTop + m->nHeight

   do case   && now for the columns
      case m->cCol = "L"
         m->nLeft = 5
      case m->cCol = "R"
         m->nLeft = 35
      otherwise && "C" or center
         m->nLeft = 20
   endcase
   m->nRight = m->nLeft + m->nWidth

   *-- define window
   activate screen
   define window wYesNo from m->nTop,m->nLeft to m->nBottom,m->nRight;
                                                    NONE color &cColor.

   *-- define menu
   define menu mYesNo
   m->nButtonRow = m->nHeight - iif(m->nStyle<3,3,2)
   m->nB1 = 5                        && column for first  button
   if m->nButtons = 3
      m->nB2 = (m->nWidth-len(m->cButton2))/2  && column for 2nd button
   else
      m->nB2 = (m->nWidth-len(m->cButton2))-4
   endif
   if m->nButtons > 2
      m->nB3 = (m->nWidth-len(m->cButton3))-4  && column for 3rd button
   endif
   define pad pPad1 of mYesNo prompt m->cButton1 at m->nButtonRow,m->nB1
   define pad pPad2 of mYesNo prompt m->cButton2 at m->nButtonRow,m->nB2
   if m->nButtons > 2
      define pad pPad3 of mYesNo prompt m->cButton3 at ;
                                                    m->nButtonRow,m->nB3
   endif
   on selection pad pPad1 of mYesNo deactivate menu
   on selection pad pPad2 of mYesNo deactivate menu
   if m->nButtons > 2
      on selection pad pPad3 of mYesNo deactivate menu
   endif

   *-- activate window
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight
   activate window wYesNo

   *-- draw border
   m->cBordCol = left(m->cColor,at(",",m->cColor)-1)
   do bord3d with 0,0,m->nHeight,m->nWidth,m->cBordCol,m->nStyle

   *-- display title
   if len(m->cTitle) < m->nWidth
      m->cTitle = justify(m->cTitle,35,"C")
      if len(m->cTitle) < 35
         m->cTitle = m->cTitle + " "
      endif
   endif
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF  = FBClrBrk("B",m->cTempCol)
   m->cColorB  = FBClrBrk("B",colorbrk(m->cColor,1))
   m->cColorAll= m->cColorF+"/"+m->cColorB
   m->nRow = iif(m->nStyle < 3,2,1)
   m->nCol = iif(m->nStyle < 3,3,2)
   @m->nRow,  m->nCol say m->cTitle color &cTempCol.
   @m->nRow+1,m->nCol say replicate(chr(223),35) color &cColorAll.

   *-- display text
   do WordWrap with iif(m->nStyle<3,4,3),iif(m->nStyle<3,4,3),;
                    m->cMessage,34

   *-- set Y/N keys for menu pad
   clear typeahead && just to be safe
   *-- if we're ON the pad user selected, do nothing, else go left or
   *-- right as needed, and then issue a "Return" (chr(13))
   m->cKey1 = substr(m->cButton1,2,1)
   m->cKey2 = substr(m->cButton2,2,1)
   if m->nButtons > 2
      m->cKey3 = substr(m->cButton3,2,1)
   endif
   if m->nButtons > 2
      on key label &cKey1. keyboard iif(pad() = "PPAD1","",;
         iif(pad()="PPAD2",chr(19),chr(4) ) )+chr(13)
      on key label &cKey2. keyboard iif(pad() = "PPAD2" ,"",;
         iif(pad()="PPAD1",chr(4),chr(19) ) )+chr(13)
      on key label &cKey3. keyboard iif(pad() = "PPAD3","",;
         iif(pad()="PPAD2",chr(4),chr(19) ) )+chr(13)
   else
      on key label &cKey1. keyboard iif(pad() = "PPAD1",;
                               chr(19),chr(4))+chr(13)
      on key label &cKey2. keyboard iif(pad() = "PPAD2",;
                               chr(4),chr(19))+chr(13)
   endif

   *-- deal with borders around the pads ...
   do bord3d with m->nButtonRow-1,m->nB1-1,m->nButtonRow+1,;
                  m->nB1+len(m->cButton1),m->cBordCol,3
   do bord3d with m->nButtonRow-1,m->nB2-1, m->nButtonRow+1,;
                  m->nB2+len(m->cButton2),m->cBordCol,3
   if m->nButtons > 2
      do bord3d with m->nButtonRow-1,m->nB3-1,m->nButtonRow+1,;
                  m->nB3+len(m->cButton3),m->cBordCol,3
   endif

   *-- activate menu
   do case
      case m->nDefault = 1
         activate menu mYesNo pad pPad1
      case m->nDefault = 2
         activate menu mYesNo pad pPad2
      case m->nDefault = 3
         activate menu mYesNo pad pPad3
      otherwise  && default to first
         activate menu mYesNo pad pPad1
   endcase

   *-- cleanup
   on key label &cKey1.
   on key label &cKey2.
   if m->nButtons > 2
      on key label &cKey3.
   endif
   release window wYesNo
   restore screen from sYesNo
   release screen sYesNo
   m->cPrompt = prompt()
   release menu mYesNo
   if .not. isblank(cWindow)
      activate window &cWindow.
   endif

RETURN substr(m->cPrompt,2,1)
*-- EoF: DIALOG2()

FUNCTION ErrorMsg
*-----------------------------------------------------------------------
*-- Programmer..: Ken Mayer (CIS: 71333,1030)
*-- Date........: 06/08/1992
*-- Notes.......: Display an error message in a Window:
*--                           ** ERROR [#] **
*--
*--                              Message 1
*--                              Message 2
*--                       Press any key to continue ...
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 06/08/1992 -- Modified for explicit color handing.
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*--               ALLTRIM()            Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: ErrorMsg("<cErr>","<cMess1>","<cMess2>","<cColor>")
*-- Example.....: lc_Dummy = errormsg("3","This record",;
*--                                   "already exists!",;
*--                                   "rg+/r,rg+/r,rg+/r")
*--               where "errornum" is an error number or nul,
*--               message2 and 3 should be 36 characters or less ...
*--               Colors should include foreground/background,;
*--                 foreground/background,foreground/background
*-- Returns.....: numeric value of keystroke user presses (cUser)
*-- Parameters..: cErr   = Error # (can be blank, but use "" for blank)
*--               cMess1 = Error message line 1
*--               cMess2 = Error message line 2
*--               cColor = Colors for text/window/border
*-----------------------------------------------------------------------

   parameters cErr,cMess1,cMess2,cColor
   private cCursor,cUser,cCurColor,cTempCol

   save screen to sErr
   activate screen
   define window wErr from 8,20 to 15,60 double color &cColor.
   do shadow with 8,20,15,60
   activate window wErr

   m->cCursor = set("CURSOR")
   set cursor off
   if len(trim(m->cErr)) > 0  && if there's an error number ...
      do center with 0,38,"","** ERROR "+alltrim(m->cErr)+" **"
   else                      && otherwise, don't display errornumber
      do center with 0,38,"","** ERROR **"
   endif
   do center with 2,38,"",m->cMess1
   do center with 3,38,"",m->cMess2
   do center with 5,38,"","Press any key to continue ..."
   m->cUser=inkey(0)

   set cursor &cCursor.
   release window wErr
   restore screen from sErr
   release screen sErr

RETURN m->cUser
*-- EoF: ErrorMsg()

FUNCTION ErrorMsg2
*-----------------------------------------------------------------------
*-- Programmer..: Ken Mayer (CIS: 71333,1030)
*-- Date........: 03/18/1993
*-- Notes.......: Display an error message in a Window:
*--                           ** ERROR [#] **
*--
*--                              Message 1
*--                              Message 2
*--
*--                       Press any key to continue ...
*--
*--               WARNING: This version produces a dialog box that is
*--               two rows taller and two columns wider than previous.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/08/1992 -- Original
*--               03/18/1993 -- Modified to give the three-d border ...
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*--               ALLTRIM()            Function in PROC.PRG
*--               BORD3D               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: ErrorMsg2("<cErr>","<cMess1>","<cMess2>","<cColor>";
*--                         [,<nStyle>])
*-- Example.....: cDummy = errormsg2("3","This record",;
*--                                  "already exists!",;
*--                                  "rg+/r,rg+/r,rg+/r",2)
*--               where "errornum" is an error number or nul,
*--               message2 and 3 should be 36 characters or less ...
*--               Colors should include foreground/background,;
*--                 foreground/background,foreground/background
*-- Returns.....: numeric value of keystroke user presses (cUser)
*-- Parameters..: cErr   = Error # (can be blank, but use "" for blank)
*--               cMess1 = Error message line 1
*--               cMess2 = Error message line 2
*--               cColor = Colors for text/window/border
*--               nStyle = OPTIONAL - style -- 1 = Raised, 2 = Recessed
*-----------------------------------------------------------------------

   parameters cErr,cMess1,cMess2,cColor,nStyle
   private cCursor,cUser,cCurColor,cTempCol

   if pCount() < 5
      m->nStyle = 1
   endif

   save screen to sErr
   activate screen
   define window wErr from 7,19 to 16,61 NONE color &cColor.
   do shadow with 7,19,16,61
   activate window wErr

   *-- do border
   do Bord3d with 9,42,m->cColor,m->nStyle

   m->cCursor = set("CURSOR")
   set cursor off
   if len(trim(m->cErr)) > 0  && if there's an error number ...
      do center with 2,42,"","** ERROR "+alltrim(m->cErr)+" **"
   else                      && otherwise, don't display errornumber
      do center with 2,42,"","** ERROR **"
   endif
   do center with 4,42,"",left(m->cMess1,38)
   do center with 5,42,"",left(m->cMess2,38)
   do center with 7,42,"","Press any key to continue ..."
   m->cUser=inkey(0)

   set cursor &cCursor.
   release window wErr
   restore screen from sErr
   release screen sErr

RETURN m->cUser
*-- EoF: ErrorMsg2()

FUNCTION ErrorMsg3
*-----------------------------------------------------------------------
*-- Programmer..: Ken Mayer (CIS: 71333,1030)
*-- Date........: 06/11/1993
*-- Notes.......: Display an error message in a Window:
*--                           ** ERROR [#] **
*--
*--                       Message (wraps in window)
*--
*--                                 [OK]
*--
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/08/1992 -- Original
*--               03/18/1993 -- Modified to give the three-d border ...
*--               06/10/1993 -- Modified to give 4 options to border,
*--                             default color of grey/black/white,
*--                             handle single message of up to 254
*--                             characters.
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*--               ALLTRIM()            Function in PROC.PRG
*--               WORDWRAP             Procedure in PROC.PRG
*--               BORD3D5              Procedure in DIALOGS.PRG
*-- Called by...: Any
*-- Usage.......: ErrorMsg3(<cErr>,<cMess>[,<cColor>[,<nStyle>]])
*-- Example.....: cDummy = errormsg3("3","This record already exists!",;
*--                   "rg+/r,rg+/r,rg+/r",2)
*-- Returns.....: numeric value of keystroke user presses (cUser)
*-- Parameters..: cErr   = Error # (can be blank, but use "" for blank)
*--               cMess  = Error message -- up to 254 characters
*--               cColor = Colors for text/window/border (default to
*--                        grey)
*--               nStyle = 1 = Double - Raised
*--                        2 = Double - Recessed
*--                        3 = Single - Raised
*--                        4 = Single - Recessed
*-----------------------------------------------------------------------

   parameters cErr,cMess,cColor,nStyle
   private cCursor,cUser,cCurColor,cTempCol

   *-- defaults
   if pCount() < 4 .or. (m->nStyle < 1 .or. m->nStyle > 4)
      m->nStyle = 1
   endif
   if pCount() < 3
      m->cColor = "n/w,w+/n,n/w"
   endif
   if isblank(m->cColor)
      m->cColor = "n/w,w+/n,n/w"
   endif

   *-- screen stuff
   save screen to sErr
   cWindow = window()
   activate screen

   *-- determine coordinates
   *-- width is a default of 36 characters, plus border ...
   m->nWidth = 36 + iif(m->nStyle < 3, 4, 2)  && based on border style

   *-- height is based on lines in message
   m->nHeight = int(len(m->cMess)/m->nWidth) +;
             iif( mod( len(m->cMess), m->nWidth) > 0,1,0) +;
             iif(m->nStyle < 3,3,1) + 6

   *-- now we have height and width, let's determine how to center this
   *-- puppy on the screen
   m->cScreen = set("DISPLAY")
   if m->cScreen = "MONO"
      m->nScreen = 24
   else
      m->nScreen = val(right(m->cScreen,2)) - 1
   endif

   *-- coordinates
   m->nTop    = (m->nScreen-m->nHeight) / 2
   m->nBottom = m->nTop + m->nHeight
   m->nLeft   = 20
   m->nRight  = m->nLeft + m->nWidth

   *-- define the window
   define window wErr from m->nTop,m->nLeft to m->nBottom,m->nRight ;
                                                   NONE color &cColor.
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight
   activate window wErr

   *-- do border
   m->cBordCol = colorbrk(m->cColor,1)
   do Bord3d5 with 0,0,(m->nBottom-m->nTop),m->nWidth,m->cBordCol,;
                                                      m->nStyle

   m->cCursor = set("CURSOR")
   set cursor off

   *-- deal with "title" line
   if len(trim(m->cErr)) > 0  && if there's an error number ...
      m->cTitle = "** ERROR "+alltrim(m->cErr)+" **"
   else                      && otherwise, don't display errornumber
      m->cTitle = "** ERROR **"
   endif
   m->cTitle = justify(m->cTitle,35,"C")
   if len(m->cTitle) < 35
      m->cTitle = m->cTitle + " "
   endif
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF  = fbclrbrk("B",m->cTempCol)
   m->cColorB  = fbclrbrk("B",colorbrk(m->cColor,1))
   m->cColorAll = m->cColorF+"/"+m->cColorB
   m->nRow = iif(m->nStyle<3,2,1)
   m->nCol = iif(m->nStyle<3,3,2)
   @m->nRow,m->nCol say m->cTitle color &cTempCol.
   @m->nRow+1,m->nCol say replicate(chr(223),35) color &cColorAll.

   *-- display message
   do wordwrap with iif(m->nStyle<3,4,3),iif(m->nStyle<3,4,3),;
                    m->cMess,34

   *-- define menu ...
   define menu mError
   m->nButtonRow = m->nHeight - iif(m->nStyle<3,3,2)
   m->nButtonCol = m->nWidth/2 - 1
   define pad pPad1 of mError prompt "[OK]" at ;
                                    m->nButtonRow,m->nButtonCol
   on selection pad pPad1 of mError deactivate menu
   on key label ctrl-M keyboard "{27}"
   do bord3d5 with m->nButtonRow-1,m->nButtonCol-1,m->nButtonRow+1,;
                                   m->nButtonCol+4,m->cBordCol,3

   *-- start menu
   activate menu mError

   *-- deal with user 'input'
   mPad = pad()

   *-- reset and cleanup
   set cursor &cCursor.
   release window wErr
   restore screen from sErr
   release screen sErr
   release menu mError
   on key label ctrl-M
   if "" # cWindow
      activate window &cWindow.
   endif

RETURN .not. "" = mPad  && empty pad?
*-- EoF: ErrorMsg3()

FUNCTION Alert
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
*-- Date........: 06/19/1992
*-- Notes.......: This routine creates a popup on the screen with a
*--               title and one line message, forcing the user to notice
*--               the message. The user must use the mouse on the 'OK'
*--               pad, press <Esc> or press <Enter> to move on in the
*--               program that called this function.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/01/1992 -- Original
*--               06/19/1992 - Modified to accept the <Enter> key by
*--               Ken Mayer, also a bit better cleanup at the end
*--               (releasing things from memory, and so on).
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Alert("<cTitle>","<cMessage>")
*-- Example.....: lX = Alert("Print Aborted","You pressed <ESC>")
*-- Returns.....: Logical
*-- Parameters..: cTitle   = Title line
*--               cMessage = One line message (up to 79 characters)
*-----------------------------------------------------------------------

   parameters cTitle, cMessage
   private wWindow,nRow,nCol,mPad

   wWindow = WINDOW()                  && save current Window
   save screen to sTemp                && save the screen
        activate screen

   m->nRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8)
                                       && center from top-bottom
   m->nCol = 38 - (max(len(m->cTitle),len(m->cMessage))/2)
                                       && center left-right
   m->nCol2 = max(len(m->cTitle),len(m->cMessage))
                                       && right side

   *-- clear out a section of the screen
   @m->nRow,m->nCol Clear to m->nRow+6,m->nCol+m->nCol2
   *-- fill in a box
   @m->nRow,m->nCol Fill  to m->nRow+6,m->nCol+m->nCol2+1 color n+
                                        && grey
   *-- put a double line border around box
   @m->nRow,m->nCol to m->nRow+6,m->nCol+m->nCol2+1 double color bg+

   *-- display title
   @m->nRow + 1,m->nCol + 1 + iif(len(m->cTitle) > len(m->cMessage),0,;
      (len(m->cMessage)-len(m->cTitle)) / 2) say m->cTitle color w+/n

   *-- display line
   @m->nRow + 2, m->nCol + 1 to m->nRow + 2, m->nCol + m->nCol2 ;
                                                       color bg+

   *-- display message
   @m->nRow + 3, m->nCol+1+iif(len(m->cTitle) > len(m->cMessage),;
      (len(m->cTitle)-len(m->cMessage)) / 2, 0) say m->cMessage ;
                                                  color w+/n

   *-- define/display a very small menu (one pad)
   define menu mAlert
   define pad pPad1 of mAlert prompt " OK " at m->nRow +5,37
   on selection pad pPad1 of mAlert deactivate menu

   *-- added by Ken to deal with <Enter>
   on key label ctrl-M keyboard "{27}"

   *-- start it up
   activate menu mAlert

   *-- deal with user 'input'
   mPad = pad()

   *-- restore environment, free up RAM by releasing things
   on key label ctrl-m
   restore screen from sTemp
   release screen sTemp
   release menu mAlert
   if "" # wWindow
      activate window &wWindow.
   endif

RETURN .not. "" = mPad  && not empty pad?
*-- EoF: Alert()

FUNCTION Alert2
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (SUPREME1)
*-- Date........: 11/16/1992
*-- Notes.......: This function based on Alert2()
*--               This routine creates a popup on the screen with a
*--               title and one line message, forcing the user to
*--               notice the message. The user must use the mouse on
*--               the 'OK' pad, press <Esc> or press <Enter> to move
*--               on in the program that called this function.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/01/1992 -- Original
*--               Modified to accept the <Enter> key by Ken Mayer.
*--               06/19/1992 -- Copied from Adam's original, uses a
*--                 window, shadow, and programmer defineable colors.
*--               07/29/1992 -- Joey stepped in and made some
*--                  modifications that seem to have helped as well,
*--                  including dealing with the keyboard buffer.
*--               10/09/1992 -- minor change -- title is now same color
*--                  as the "pad".
*--               11/12/1992 -- changed to look more like a Win 3.0/3.1
*--                 window by printing a special 'line' below the title.
*--                 Also removed hard coding which forced border to
*--                 DOUBLE so that if called with border set to NONE,
*--                 gives even more Win-like appearance.  Calls a new
*--                 function written for this technique, but can be used
*--                 in other programs.
*--               11/16/1992 -- modified to add cBORDER parameter ...
*--                 (K. Mayer)
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               CENTER               Procedure in PROC.PRG
*--               JUSTIFY()            Function in PROC.PRG
*--               COLORBRK()           Function in PROC.PRG
*--               FBCLRBRK()           Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: Alert2("<cTitle>","<cMessage>","<cColor>"[,;
*--                      "<cBorder>"])
*-- Example.....: ** if no border, I suggest colors which will contrast
*--                  with the active screen or window
*--               lX = Alert2("Print Aborted","You pressed <ESC>",;
*--                           "rg+/r,w+/b,rg+/r","NONE")
*-- Returns.....: Logical
*-- Parameters..: cTitle   = Title line
*--               cMessage = One line message (up to 75 characters)
*--               cColor   = Colors: <window forg/back>,<pad> (and
*--                                  title),<box>
*--               cBorder  = Border type (DOUBLE, SINGLE, NONE,
*--                           PANEL) -- optional -- will default to
*--                           your setting
*-----------------------------------------------------------------------

   parameters cTitle, cMessage, cColor, cBorder
   private wWindow,nRow,nCol,mPad,cTempCol,cColorF,cColorB,cColorAll,;
           lNoBorder

   wWindow = WINDOW()                  && save current Window
   save screen to sTemp                && save the screen
   activate screen
   m->cDummykey = inkey()              && clear out keyboard buffer
   m->cOldBorder = set("BORDER")       && get old border setting
   if .not. type("m->cBorder") = "L"   && if user set border ...
      set border to &cBorder.          && start NEW border setting
   endif
   m->lNoBorder = set("BORDER") = "NONE"  && is there a border?

   *-- get window coordinates
   *-- this centers from top to bottom, depending on monitor setup ...
   m->nULRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8)
   *-- add rows, number depends on border, so the Window is large
   *-- enough ...
   if m->lNoBorder
      m->nBRRow = m->nULRow + 4
   else
      m->nBRRow = m->nULRow + 6
   endif
   *-- left column ...
   m->nULCol = 36 - (max(len(m->cTitle),len(m->cMessage))/2)
                                        && center left-right
   *-- right column ...
   m->nBRCol = m->nULCol + max(len(m->cTitle),len(m->cMessage))+4
                                        && right side?
   *-- Window width ...
   m->nWidth = m->nBRCol - m->nULCol - 1

   *-- define window
   activate screen

   Define window wAlert from m->nULRow,m->nULCol to m->nBRRow,m->nBRCol;
                                                    color &cColor.

   *-- display shadow
   do shadow with m->nULRow,m->nULCol,m->nBRRow,m->nBRCol

   *-- start 'er up ...
   activate window wAlert

   *-- display title
   m->cTempCol = colorbrk(m->cColor,2)
   if len(m->cTitle) < m->nWidth
       m->cTitle = justify(m->cTitle,iif(m->lNoBorder,m->nWidth+2,;
                           m->nWidth),"C")
       if len(m->cTitle) < m->nWidth
          m->cTitle = m->cTitle + " "
       endif
   endif

   *-- display  a new type type line to look more like Win
   m->cColorF   = FBClrBrk("B",m->cTempCol)
   m->cColorB   = FBClrBrk("B",colorbrk(m->cColor,1))
   m->cColorAll = m->cColorF + "/" + m->cColorB
   if m->lNoBorder
     do center with 0,m->nWidth + 3,m->cTempCol,m->cTitle
     *-- chr(223) looks like this --> fl <--
     @ 1,0 say replicate(chr(223),m->nWidth + 2) color &cColorAll.
   else
     do center with 0,m->nWidth,m->cTempCol,m->cTitle
     @ 1,0 say replicate(chr(223),m->nWidth) color &cColorAll.
   endif

   *-- display message
   do center with 2,m->nWidth,"",m->cMessage

   *-- define/display a very small menu (one pad)
   define menu mAlert
   define pad pPad1 of mAlert prompt "[OK]" at 4,(m->nWidth/2-2)
   on selection pad pPad1 of mAlert deactivate menu

   *-- added by Ken to deal with <Enter>
   on key label ctrl-M keyboard "{27}"

   *-- start it up
   activate menu mAlert

   *-- deal with user 'input'
   mPad = pad()
   release window wAlert

   *-- restore environment, free up RAM by releasing things
   on key label ctrl-m
   restore screen from sTemp
   release screen sTemp
   release menu mAlert
   if "" # wWindow
       activate window &wWindow.
   endif
   set border to &cOldBorder.

RETURN .not. "" = mPad  && not empty pad?
*-- EoF: Alert2()

FUNCTION Alert3
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (SUPREME1)
*-- Date........: 12/23/1992
*-- Notes.......: This function based on Alert2()
*--               This routine creates a popup on the screen with a
*--               title and one line message, forcing the user to
*--               notice the message. The user must use the mouse on
*--               the 'OK' pad, press <Esc> or press <Enter> to move
*--               on in the program that called this function.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/19/1992 - Original
*--               Modified to accept the <Enter> key by Ken Mayer.
*--               06/19/1992 -- Copied from Adam's original, uses a
*--                 window, shadow, and programmer defineable colors.
*--               07/29/1992 -- Joey stepped in and made some
*--                 modifications that seem to have helped as well,
*--                 including dealing with the keyboard buffer.
*--               10/09/1992 -- minor change -- title is now same color
*--                 as the "pad".
*--               11/12/1992 -- changed to look more like a Win 3.0/3.1
*--                 window by printing a special 'line' below the title.
*--                 Also removed hard coding which forced border to
*--                 DOUBLE so that if called with border set to NONE,
*--                 gives even more Win-like appearance.  Calls a new
*--                 function written for this technique, but can be
*--                 used in other programs.
*--               11/16/1992 -- modified to add cBORDER parameter ...
*--                 (K. Mayer)
*--               12/23/1992 -- tuned up centering of cTitle, cMessage,
*--                  and [OK] pad.  Eliminated calls to Center.prg by
*--                  using Justify() along with @ say. (Joey D. Carroll)
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               JUSTIFY()            Function in PROC.PRG
*--               COLORBRK()           Function in PROC.PRG
*--               FBCLRBRK()           Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: Alert2("<cTitle>","<cMessage>","<cColor>"[,;
*--                      "<cBorder>"])
*-- Example.....: ** if no border, I suggest colors which will contrast
*--                  with the active screen or window
*--               lX = Alert2("Print Aborted","You pressed <ESC>",;
*--                           "rg+/r,w+/b,rg+/r","NONE")
*-- Returns.....: Logical
*-- Parameters..: cTitle   = Title line
*--               cMessage = One line message (up to 75 characters)
*--               cColor   = Colors: <window forg/back>,<pad> (and
*--                                  title),<box>
*--               cBorder  = Border type (DOUBLE, SINGLE, NONE, PANEL)
*--                          optional -- will default to your setting
*-----------------------------------------------------------------------

   parameters cTitle, cMessage, cColor, cBorder
   private wWindow,mPad,cTempCol,cColorF,cColorB,cColorAll
   private nWidth,nULRow,m->nULCol,nLRRow,nLRCol,cTitle2,cMessage2,;
           nBorder

   m->cTitle2 = " " + ltrim(trim(m->cTitle)) + " "
                                  && don't jamb against walls
   m->cMessage2 = " " + ltrim(trim(m->cMessage)) + " "
                                  && don't jamb against walls
   wWindow = WINDOW()             && save current Window
   save screen to sTemp           && save the screen
   activate screen
   m->cDummykey = inkey()         && clear out keyboard buffer
   m->cOldBorder = set("BORDER")  && get old border setting
   if .not. type("m->cBorder") = "L"  && if user set border ...
      set border to &cBorder.         && start NEW border setting
   endif
   m->nBorder   = iif(set("BORDER") = "NONE",0,2)  && border factor

   *-- get window coordinates
   *-- this centers from top to bottom, depending on monitor setup ...
   m->nULRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8)

   *-- add rows, number depends on border, so the Window is large enough
   m->nBRRow = m->nULRow + 5 +m->nBorder

   *-- left column ...
   m->nULCol = 40 - (max(len(m->cTitle2),len(m->cMessage2))/2)
                                                   && center left-right
   *-- right column ...
   m->nBRCol = m->nULCol + max(len(m->cTitle2),len(m->cMessage2)) + ;
               (m->nBorder - 1)
   *-- Window width ...
   m->nWidth = m->nBRCol - m->nULCol - 1

   *-- define window
   Define window wAlert from m->nULRow,m->nULCol to ;
                             m->nBRRow,m->nBRCol color &cColor.

   *-- display shadow
   do shadow with m->nULRow,m->nULCol,m->nBRRow,m->nBRCol

   *-- start 'er up ...
   activate window wAlert

   *-- display  a new type type line to look more like Win
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF   = FBClrBrk("B",m->cTempCol)
                                  && background of title bar text
   m->cColorB   = FBClrBrk("B",colorbrk(m->cColor,1))
                                  && foreground of 'normal' text
   m->cColorAll = m->cColorF + "/" + m->cColorB
                                  && color of 'special' line
   @ 0,0 say justify(m->cTitle2,m->nWidth + ;
                     iif(m->nBorder = 0,4,2),"C") ;
                     color &cTempCol.          && the Title Bar
   *-- chr(223) looks like this --> fl <--
   @ 1,0 say replicate(chr(223),m->nWidth + 2) color &cColorAll.
                                    && make thicker

   *-- display message
   @ 2,0 say justify(m->cMessage2,m->nWidth + ;
                     iif(m->nBorder = 0,4,2),"C")
   *-- define/display a very small menu (one pad)
   define menu mAlert
   define pad pPad1 of mAlert prompt "[OK]" at 4,;
                               ((m->nWidth-m->nBorder-2)/2)
   on selection pad pPad1 of mAlert deactivate menu

   *-- added by Ken to deal with <Enter>
   on key label ctrl-M keyboard "{27}"

   *-- start it up
   activate menu mAlert

   *-- deal with user 'input'
   mPad = pad()
   release window wAlert

   *-- restore environment, free up RAM by releasing things
   on key label ctrl-m
   restore screen from sTemp
   release screen sTemp
   release menu mAlert
   if "" # wWindow
       activate window &wWindow.
   endif
   set border to &cOldBorder.

RETURN .not. "" = mPad  && not empty pad?
*-- EoF: Alert3()

FUNCTION Alert4
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (SUPREME1)
*-- Date........: 03/15/1993
*-- Notes.......: This function based on Alert3()
*--               This routine creates a popup on the screen with a
*--               title and one line message, forcing the user to
*--               notice the message. The user must use the mouse on
*--               the 'OK' pad, press <Esc> or press <Enter> to move on
*--               in the program that called this function.
*--               WARNING: If it matters to you, this dialog box is
*--               two rows higher, and two columns wider than previous
*--               versions.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/19/1992 -- Original
*--               03/15/1993 -- Modified by Ken Mayer to give 3-D border
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               JUSTIFY()            Function in PROC.PRG
*--               COLORBRK()           Function in PROC.PRG
*--               FBCLRBRK()           Function in PROC.PRG
*--               BORD3D               Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: Alert4("<cTitle>","<cMessage>","<cColor>"[,<nStyle>])
*-- Example.....: lX = Alert4("Print Aborted","You pressed <ESC>",;
*--                           "rg+/r,w+/b,rg+/r",2)
*-- Returns.....: Logical
*-- Parameters..: cTitle   = Title line
*--               cMessage = One line message (up to 75 characters)
*--               cColor   = Colors: <window forg/back>,<pad> (and
*--                          title),<box>
*--               nStyle   = OPTIONAL: Style 1 (default) = raised border
*--                                    Style 2           = inset border
*-----------------------------------------------------------------------

   parameters cTitle, cMessage, cColor, nStyle
   private wWindow,mPad,cTempCol,cColorF,cColorB,cColorAll
   private nWidth,nULRow,nULCol,nLRRow,nLRCol,cTitle2,cMessage2

   m->cTitle2 = " " + ltrim(trim(m->cTitle)) + " "
                                      && don't jamb against walls
   m->cMessage2 = " " + ltrim(trim(m->cMessage)) + " "
                                      && don't jamb against walls
   wWindow = WINDOW()                 && save current Window
   save screen to sTemp               && save the screen
   activate screen
   m->cDummykey = inkey()             && clear out keyboard buffer
   if pCount() < 4
      m->nStyle = 1
   endif

   *-- get window coordinates
   *-- this centers from top to bottom, depending on monitor setup ...
   m->nULRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8)
   *-- add rows, number depends on border, so the Window is large enough
   m->nBRRow = m->nULRow + 8

   *-- left column ...
   m->nULCol = (40 - (max(len(m->cTitle2),len(m->cMessage2))/2)) -2
                                        && center left-right
   *-- right column ...
   m->nBRCol = m->nULCol + max(len(m->cTitle2),len(m->cMessage2)) + 5
   *-- Window width ...
   m->nWidth = m->nBRCol - m->nULCol

   *-- define window (with no border so we can place the 3-D one on it)
   Define window wAlert from m->nULRow,m->nULCol to m->nBRRow,m->nBRCol;
                                                   NONE color &cColor.

   *-- display shadow
   do shadow with m->nULRow,m->nULCol,m->nBRRow,m->nBRCol

   *-- start 'er up ...
   activate window wAlert

   *-- put 3-D Border in there
   do BORD3D with (m->nBRRow-m->nULRow),m->nWidth,m->cColor, m->nStyle

   *-- display  a new type type line to look more like Win
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF   = FBClrBrk("B",m->cTempCol)
                               && background of title bar text
   m->cColorB   = FBClrBrk("B",colorbrk(m->cColor,1))
                               && foreground of 'normal' text
   m->cColorAll = m->cColorF + "/" + m->cColorB
                               && color of 'special' line
   @ 2,3 say justify(m->cTitle2,m->nWidth - 5 ,"C");
               color &cTempCol.            && the Title Bar
   *-- chr(223) looks like this --> fl <--
   @ 3,3 say replicate(chr(223),m->nWidth - 5) color &cColorAll.
                               && make thicker

   *-- display message
   @ 4,3 say justify(m->cMessage2,m->nWidth - 5,"C")
   *-- define/display a very small menu (one pad)
   define menu mAlert
   define pad pPad1 of mAlert prompt "[OK]" at 6,((m->nWidth-5)/2)+1
   on selection pad pPad1 of mAlert deactivate menu

   *-- added by Ken to deal with <Enter>
   on key label ctrl-M keyboard "{27}"

   *-- start it up
   activate menu mAlert

   *-- deal with user 'input'
   mPad = pad()
   deactivate window wAlert
   release window wAlert

   *-- restore environment, free up RAM by releasing things
   on key label ctrl-m
   restore screen from sTemp
   release screen sTemp
   release menu mAlert
   if "" # wWindow
       activate window &wWindow.
   endif

RETURN .not. "" = mPad  && not empty pad?
*-- EoF: Alert4()

FUNCTION Alert5
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 06/11/1993
*-- Notes.......: This is a general purpose "ALERT" dialog box. It is
*--               based heavily on the original work by Adam L. Menkes
*--               (Borland Technical Support), and Joey D. Carrol, as
*--               well as various tinkerings I have done in previous
*--               versions. This routine creates a popup on the screen
*--               with a title and one line message, forcing the user
*--               to notice the message.
*--               The user must use the mouse on the 'OK' pad, press
*--               <Esc> or press <Enter> to move on in the program
*--               that called this function.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/19/1992 -- Adam L. Menkes -- Original "Alert()"
*--                             routine.
*--               06/11/1993 -- Kenneth J. Mayer -- complete overhaul.
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               JUSTIFY()            Function in PROC.PRG
*--               COLORBRK()           Function in PROC.PRG
*--               FBCLRBRK()           Function in PROC.PRG
*--               BORD3D5              Procedure in DIALOGS.PRG
*-- Called by...: Any
*-- Usage.......: Alert5("<cTitle>","<cMessage>","<cColor>"[,<nStyle>])
*-- Example.....: lX = Alert5("Print Aborted","You pressed <ESC>",;
*--                           "rg+/r,w+/b,rg+/r",2)
*-- Returns.....: Logical
*-- Parameters..: cTitle   = Title line
*--               cMessage = One line message (up to 254 characters)
*--               cColor   = Colors: <window forg/back>,<pad> (and
*--                          title),<box>
*--                          Default is to "steel" grey
*--               nStyle   = OPTIONAL: 1 = double raised border(default)
*--                                    2 = double recessed bord
*--                                    3 = single raised
*--                                    4 = single recessed
*-----------------------------------------------------------------------

   parameters cTitle, cMessage, cColor, nStyle
   private wWindow,mPad,cTempCol,cColorF,cColorB,cColorAll
   private nWidth,nTop,nLeft,nBottom,nRight,cTitle2,cMessage2

   m->cTitle2 = " " + ltrim(trim(m->cTitle)) + " "
                                       && don't jamb against walls
   m->cMessage2 = " " + ltrim(trim(m->cMessage)) + " "
                                       && don't jamb against walls
   wWindow = WINDOW()                  && save current Window
   save screen to sTemp                && save the screen
   activate screen
   m->cDummykey = inkey()              && clear out keyboard buffer

   *-- deal with defaults
   if pCount() < 4 .or. (m->nStyle < 1 .or. m->nStyle > 4)
      m->nStyle = 1
   endif
   if pCount() < 3                     && no colors? default to grey
      m->cColor = "n/w,w+/n,n/w"
   endif
   if isblank(m->cColor)
      m->cColor = "n/w,w+/n,n/w"
   endif

   *-- determine coordinates -- we're basing some of this on YESNO()
   *-- routines -- alert box will be only so wide ...
   m->nWidth = 36 + iif(m->nStyle<3,4,2)

   *-- height will be based on how many lines of message we have
   m->nHeight = int(len(m->cMessage)/m->nWidth) +;
             iif(mod(len(m->cMessage),m->nWidth) > 0,1,0) +;
             iif(m->nStyle < 3,3,1) + 6

   *-- now we have height and width, let's determine where
   *-- to center this. First, we need screen height
   m->cScreen = set("DISPLAY")
   if m->cScreen = "MONO"
      m->nScreen = 24
   else
      m->nScreen = val(right(m->cScreen,2)) - 1  && (EGA25 = 0 to 24)
   endif

   *-- now to determine coordinates
   m->nTop     = (m->nScreen - m->nHeight) / 2
   m->nBottom  = m->nTop + m->nHeight
   m->nLeft    = 20
   m->nRight   = m->nLeft + m->nWidth

   *-- define window (with no border so we can place the 3-D one on it)
   Define window wAlert from m->nTop,m->nLeft to m->nBottom,m->nRight ;
                                                 NONE color &cColor.

   *-- display shadow
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight

   *-- start 'er up ...
   activate window wAlert

   *-- put 3-D Border in there
   m->cBordCol = colorbrk(m->cColor,1)
   do BORD3D5 with 0,0,(m->nBottom-m->nTop),m->nWidth,m->cBordCol,;
                                                      m->nStyle

   *-- display a new type title line to look more like Win
   if len(m->cTitle) < m->nWidth
      m->cTitle = justify(m->cTitle,35,"C")
      if len(m->cTitle) < 35
         m->cTitle = m->cTitle + " "
      endif
   endif
   m->cTempCol = colorbrk(m->cColor,2)
   m->cColorF   = FBClrBrk("B",cTempCol)
                                       && background of title bar text
   m->cColorB   = FBClrBrk("B",colorbrk(m->cColor,1))
                                       && foreground of 'normal' text
   m->cColorAll = m->cColorF + "/" + m->cColorB
                                       && color of 'special' line
   m->nRow = iif(m->nStyle<3,2,1)
   m->nCol = iif(m->nStyle<3,3,2)
   @m->nRow,  m->nCol say m->cTitle color &cTempCol.
                                       && the Title Bar
   @m->nRow+1,m->nCol say replicate(chr(223),35) color &cColorAll.

   *-- display message
   do WordWrap with iif(m->nStyle<3,4,3),iif(m->nStyle<3,4,3),;
                                         m->cMessage,34

   *-- define/display a very small menu (one pad)
   define menu mAlert
   m->nButtonRow = m->nHeight - iif(m->nStyle<3,3,2)
   m->nButtonCol = m->nWidth/2 - 1
   define pad pPad1 of mAlert prompt "[OK]" at m->nButtonRow,;
                                               m->nButtonCol
   on selection pad pPad1 of mAlert deactivate menu

   *-- added by Ken to deal with <Enter>
   on key label ctrl-M keyboard "{27}"

   *-- before starting, put a border around the button
   do bord3d5 with m->nButtonRow-1,m->nButtonCol-1,m->nButtonRow+1,;
                                   m->nButtonCol+4,m->cBordCol,3

   *-- start it up
   activate menu mAlert

   *-- deal with user 'input'
   mPad = pad()
   deactivate window wAlert
   release window wAlert

   *-- restore environment, free up RAM by releasing things
   on key label ctrl-m
   restore screen from sTemp
   release screen sTemp
   release menu mAlert
   if "" # wWindow
       activate window &wWindow.
   endif

RETURN .not. "" = mPad  && not empty pad?
*-- EoF: Alert5()

FUNCTION Surround2
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 03/18/1993
*-- Notes.......: Displays a message surrounded by a box anywhere on
*--               the screen -- this version centers automatically on
*--               the screen and gives a 3-D border ...
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 04/19/1991 - Modified by Ken Mayer (CIS: 71333,1030)
*--                            to a function from original procedure
*--               05/24/1991 -- Added shadow
*--               03/18/1993 -- Made 3D, and auto-center at "row".
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               BORD3D2              Procedure in PROC.PRG
*-- Called by...: Any
*-- Usage.......: surround2(<nLine>,"<cColor>","<cText>"[,<nStyle>])
*-- Example.....: cDummy = surround2(5,12,"RG+/GB",;
*--                        "Processing ... Do not Touch!",1)
*-- Returns.....: Nul/""
*-- Parameters..: nLine   = Line to display "surrounded" message at
*--               cColor  = Color variable/colors
*--               cText   = Text to be displayed inside box
*--               nStyle  = Style of border (1 = Raised, 2 = Recessed)
*--                         OPTIONAL
*-----------------------------------------------------------------------

   parameters nLine,cColor,cText,nStyle

   if pCount() < 4
      m->nStyle = 1
   endif

   *-- deal with border -- save old setting, set to single
   m->cBorder = set("BORDER")
   set border to single

   m->cText2 = " "+trim(m->cText)+" "
                                       && add spaces to left and right
   m->nTextStart = (81-len(trim(m->cText2)))/2
                                       && centered text on screen
   activate screen
   m->nTop    = m->nLine - 2
   m->nLeft   = m->nTextStart - 3       && back up 3
   m->nBottom = m->nLine + 2            && bottom row
   m->nRight  = (81-m->nTextStart) + 3  && right 3

   *-- draw shadow
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight

   *-- fill in box
   @m->nTop,m->nLeft fill to m->nBottom,m->nRight color &cColor.

   *-- place border on top of it
   do bord3d2 with m->nTop,m->nLeft,m->nBottom,m->nRight,;
                   m->cColor,m->nStyle

   *-- finally, let's display the text ...
   @m->nLine, m->nTextStart say m->cText2 color &cColor. && display text

RETURN ""
*-- EoF: Surround2()

FUNCTION Surround3
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 06/09/1993
*-- Notes.......: Displays a message surrounded by a box anywhere on
*--               the screen -- this version centers automatically on
*--               the screen and gives a 3-D border ...
*--               This is based on the original routine by Miriam
*--               Liskin.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/09/1993 -- Original
*-- Calls.......: SHADOW               Procedure in PROC.PRG
*--               BORD3D5              Procedure in DIALOGS.PRG
*-- Called by...: Any
*-- Usage.......: surround3(<nLine>,"<cColor>","<cText>"[,<nStyle>])
*-- Example.....: cDummy = surround3(5,12,"RG+/GB",;
*--                        "Processing ... Do not Touch!",1)
*-- Returns.....: Nul/""
*-- Parameters..: nLine   = Line to display "surrounded" message at
*--                         if nLine = 0, we will center on the screen
*--                         vertically, as well as horizontally.
*--               cColor  = Color variable/colors (Default to grey)
*--               cText   = Text to be displayed inside box
*--               nStyle  = Style of border 1 = Double - Raised(Default)
*--                                         2 = Double - Recessed
*--                                         3 = Single - Raised
*--                                         4 = Double - Recessed
*--                          NOTE: This is OPTIONAL
*-----------------------------------------------------------------------

   parameters nLine,cColor,cText,nStyle
   private nStyle, cColor, cBorder, cText2, nTextStart, nTop, nLeft, ;
           nBottom, nRight, nLine

   *-- deal with defaults
   if pCount() < 4 .or. (m->nStyle < 1 .or. m->nStyle > 4)
                                       && set default border style
      m->nStyle = 1
   endif
   if isblank(m->cColor)
      m->cColor = "n/w"
   endif

   *-- deal with nLine being equal to 0 when user passes this
   *-- (this will cause the routine to center on the screen ...
   *-- no matter how the screen is set).
   if m->nLine = 0
      m->cScreen = set("DISPLAY")
      if m->cScreen = "MONO"
         m->nScreen = 24
      else
         m->nScreen = val(right(m->cScreen,2)) - 1  && EGA25 = 0 to 24
      endif
      m->nLine = int(m->nScreen/2)  && halfway ...
   endif

   m->cText2 = " "+trim(m->cText)+" "  && add spaces to left and right
   m->nTextStart = (81-len(trim(m->cText2)))/2
                                       && centered text on screen
   activate screen
   m->nTop    = m->nLine - iif(m->nStyle < 3,2,1)  && up 2 or 1 ...
   m->nLeft   = m->nTextStart - iif(m->nStyle < 3,3,2)
                                       && back up 3 (or 2 if single)
   m->nBottom = m->nLine + iif(m->nStyle < 3,2,1)  && bottom row
   m->nRight  = (81-m->nTextStart) + iif(m->nStyle < 3,3,2)
                                       && right 3 (or 2 if single)

   *-- draw shadow
   do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight

   *-- fill in box
   @m->nTop,m->nLeft fill to m->nBottom,m->nRight color &cColor.

   *-- place border on top of it
   do bord3d5 with m->nTop,m->nLeft,m->nBottom,m->nRight,;
                   m->cColor,m->nStyle

   *-- finally, let's display the text ...
   @m->nLine, m->nTextStart say m->cText2 color &cColor. && display text

RETURN ""
*-- EoF: Surround3()

FUNCTION Radio
*-----------------------------------------------------------------------
*-- Programmer..: Ed Lafferty (CIS: 76150,3302)
*-- Date........: 06/08/1992
*-- Notes.......: Routine to create and size a popup with radio buttons
*--               for choosing only one of up to four options.  Pressing
*--               the <Space Bar> on an option turns it on or off.
*--               Pressing <Enter> chooses the selected option and
*--               leaves the routine.
*-- Written for.: dBase IV, 1.1
*-- Rev. History: 02/25/1992 - original procedure.
*--               02/27/1992 -- Ken Mayer -- added option for color,
*--               but had to take number of choices back to 4 to do so.
*--               Minor alterations performed to add color choice ...
*--               and cleaning up after self ... (original cleared the
*--               screen first ... this version saves screen, restores
*--               back to it ...) Oh yeah, I turned it into a function,
*--               rather than a procedure, as well.
*-- Calls.......: CENTER                Procedure in PROC.PRG
*--               SHADOW                Procedure in PROC.PRG
*--               COLORBRK()            Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: Radio(<nULRow>,<nULCol>,<nChoice>,"<cTxt1>",;
*--                     "<cTxt2>","<cTxt3>","<cTxt4>","<cTitle>",;
*--                     "<cColor>")
*-- Example.....: cPort = Radio(8,15,1,"LPT1","LPT2","LPT3","",;
*--                       "Choose a printer port","rg+/gb,n/w,rg+/gb")
*-- Returns.....: number of chosen button in nChoice
*-- Parameters..: nUlrow  = upper left row of popup
*--               nUlcol  = upper left column of popup
*--               nChoice = default chosen button
*--               cTxt1   = Text for 1st button
*--               cTxt2   =  "    "  2nd   "
*--               cTxt3   =  "    "  3rd   "
*--               cTxt4   =  "    "  4th   "
*--               cTitle  = Text for the box title
*--               cColor  = Color string (i.e., "RG+/GB,N/W,RG+/GB")
*-----------------------------------------------------------------------


   parameters nUlrow, nUlcol, nChoice, cTxt1, cTxt2, cTxt3, cTxt4, ;
               cTitle, cColor
   private nHeight, nKey, nCnt, nWidth, cStr, cTxt0, cMidCol, ;
           cFirstCol, cCursor

   m->cCursor = set("CURSOR")
   store m->cTitle to m->cTxt0
   save screen to sRadio
   store 0 to m->nHeight, m->nKey, m->nCnt, m->nWidth
   store m->nChoice to m->nOrig  && in case user presses <Esc> to exit

   *-- deal with these colors in displaying some stuff ...
   m->cMidCol = colorbrk(m->cColor,2)
   *-- First color (for message) is easier ...
   m->cFirstCol = colorbrk(m->cColor,1)

   *-- Determine height and width of popup
   do case
      case len(m->cTxt4) > 0
         m->nHeight = 4
      case len(m->cTxt3) > 0
         m->nHeight = 3
      case len(m->cTxt2) > 0
         m->nHeight = 2
      otherwise
         m->nHeight = 1
   endcase

   do while m->nCnt <= m->nHeight
      store "cTxt"+str(m->nCnt,1) to m->cStr
      if len(&cstr.) > m->nWidth
         m->nWidth = len(&cStr.)
      endif
      m->nCnt = m->nCnt + 1
   enddo

   *-- create popup
   define window wRadio from m->nULRow,m->nULCol to ;
                        m->nULRow+m->nHeight+3,m->nULCol+m->nWidth+9;
                        double color &cColor.
   do center with 23,80,m->cFirstCol,"Press "+chr(24)+chr(25)+;
                      ", <Space> to select/de-select, <Enter> to quit"
   activate screen
   do shadow with m->nULRow, m->nULCol, m->nULRow+m->nHeight+3, ;
                                        m->nULCol+m->nWidth+9
   activate window wRadio

   *-- display screen
   store 1 to m->nCnt
   do center with 0, m->nWidth+8, "", m->cTitle
   do while m->nCnt <= m->nHeight
      store "cTxt"+str(m->nCnt,1) to m->cStr
      @ m->nCnt+1, 2 SAY "[ ]" color &cMidCol.
      @ m->nCnt+1, 6 say &cStr.
      m->nCnt = m->nCnt + 1
   enddo

   *-- prepare for and get nChoice
   if m->nChoice > 0
      store m->nChoice to m->nCnt
      @m->nCnt+1,3 say "˛" color &cMidCol.
   else
      store 1 to m->nCnt
   endif
   store .F. to m->lDone

   *-- this loop processes user input ...
   do while .not. m->lDone
      @ m->nCnt+1,3 say "" color &cMidCol.
      m->nKey = inkey(0)
      do case
      case m->nKey = 27                   && Press Esc to exit
         store m->nOrig to m->nChoice     && Leave at "default"
         store .T. to m->lDone
      case m->nKey = 13
         store .T. to m->lDone
      case m->nKey = 32                   && Press Enter or Space
            set cursor off
            if m->nChoice = m->nCnt
               @ m->nCnt+1,3 say " " color &cMidCol.
               store 0 to m->nChoice
            else
               @ m->nChoice+1,3 say " " color &cMidCol.
               @ m->nCnt+1,3 say "˛" color &cMidCol.
               store m->nCnt to m->nChoice
            endif
            set cursor on
      case m->nKey = 5                    && Press up arrow
         if m->nCnt > 1
            m->nCnt = m->nCnt - 1
         else
            m->nCnt = m->nHeight
         endif
      case m->nKey = 24                   && Press down arrow
         if m->nCnt < m->nHeight
            m->nCnt = m->nCnt + 1
         else
            m->nCnt = 1
         endif
      endcase
   enddo

   *-- cleanup
   release window wRadio
   restore screen from sRadio
   release screen sRadio
   set message to
   set cursor &cCursor.

RETURN m->nChoice
*-- EoF: Radio()

PROCEDURE CheckBox
*-----------------------------------------------------------------------
*-- Programmer..: Ed Lafferty (CIS: 76150,3302)
*-- Date........: 04/22/1993
*-- Notes.......: Routine to create and size a popup with check boxes
*--               for choosing any of a number (up to five) options.
*--               Pressing the <Space Bar> on an option turns it on or
*--               off. Pressing <Enter> chooses the selected option and
*--               leaves the routine. You must use a data structure with
*--               logical fields, or memvars that are logical for this.
*--               Either way, even if you don't use five logical
*--               fields/memvars, you must pass a field/memvar to the
*--               procedure -- see Example below (the logicals -- lCHK1,
*--               lCHK2, etc.-- must be fields or memvars due to a
*--               limitation in parameter passing in dBASE IV.)
*-- Written for.: dBase IV, Version 1.5+
*-- Rev. History: 02/25/1992 -- Original procedure.
*--               02/28/1992 -- Ken Mayer -- modified to allow passing
*--                             cColor, and a little cleanup of code
*--                             and such. Minor changes.
*--               04/22/1993 -- Angus Scott-Fleming:
*--                   Revised for 1.5:
*--                   Turned cursor on
*--                   Moved help-line info inside box.
*--                   Reorganized parameters to allow calling
*--                      with variable # of choices, and evaluate with
*--                      pCOUNT()
*--                   NOTE: If more than 9 pairs are needed, two loops
*--                      will have to be changed from STR(NCNT,1) to
*--                      lTrim(STR(cCnt,2))
*--                   Enabled error-trapping for poorly located boxes.
*--                   Appended "." to all &Macros.
*-- Calls.......: CENTER               Procedure in PROC.PRG
*--               SHADOW               Procedure in PROC.PRG
*--               COLORBRK()           Function in PROC.PRG
*-- Called by...: Any
*-- Usage.......: do checkbox with <nULCol>,<nULRow>,<cTitle>,<cColor>,;
*--                          <lchk1>,<cTxt1>,[<lchk2>,<cTxt2>];
*--                          [,<lchk3>,<cTxt3>][,<lchk4>,<cTxt4>];
*--                          [... to 9]
*-- Example.....: do Checkbox with 8, 15, "Choose a printer port",;
*--                    "rg+/gb,w+/n,rg+/gb", lchk1, "LPT1", lchk2, ;
*--                     "LPT2", lchk3, "LPT3"
*-- Returns.....: .T. for selected items, .F. for non-selected items --
*--               this routine changes the value of the logical fields
*--               passed to it.
*-- Parameters..: nULRow = upper left row of popup
*--               nULCol = upper left column of popup
*--               cTitle = Title for box
*--               cColor = Colors for window
*--               lChkn  = default value of box 'n' --
*--                        MUST BE FIELDS/MEMVARS
*--               cTxtn  = Text for 'n'th box
*--               cColor = Colors to be used in window ...
*-----------------------------------------------------------------------

   parameters nUlrow, nUlcol, cTitle, cColor, lChk1, cTxt1, lChk2, ;
              cTxt2,lChk3, cTxt3, lChk4, cTxt4, lChk5, cTxt5, lChk6,;
              cTxt6,lChk7, cTxt7, lChk8, cTxt8, lChk9, cTxt9
   private nHeight, nKey, nCnt, nWidth, cMidCol, cFirstCol, cCursor,;
              cPrompt, nBRRow, nBRCol

   *-- setup ...
   m->cCursor = set("CURSOR")
   save screen to sCheck
   store 0 to m->nHeight, m->nKey, m->nWidth
   m->cPrompt = "Press "+chr(24)+chr(25)+;
      ", <Space> to select/de-select, <Enter> to quit"

   *-- save original settings, in case <Esc> gets pressed below ...
   *-- determine height/width of popup
   m->nWidth  = max(len(m->cPrompt),len(m->cTitle))
   m->nHeight = (pcount() - 4)/2
   m->nCnt    = 0
   do while m->nCnt < m->nHeight
      m->nCnt = m->nCnt + 1
      m->cCnt = str(m->nCnt,1)
      private lOrig&cCnt.
      store lChk&cCnt. to lOrig&cCnt.
      m->nWidth = max(m->nWidth,len(cTxt&cCnt.))
   enddo
   *-- add border to window
   m->nWidth = min(m->nWidth+8,79)

   *-- deal with some colors ...
   m->cMidCol   = colorbrk(m->cColor,2)
   m->cFirstCol = colorbrk(m->cColor,1)

   *-- create popup and trap errors defining the window
   m->nBRRow = m->nULRow + m->nHeight + 5
   m->nBRCol = m->nULCol + m->nWidth
   if m->nBRRow > 24
      *-- center window vertically
      m->nULRow = max(12-(m->nHeight+5)/2,0)
      m->nBRRow = min(23,(m->nULRow+m->nHeight+5))
   endif
   if m->nBRCol > 80
      *-- center window horizontally
      m->nULCol = max(40 - m->nWidth/2,0)
      m->nBRCol = min(79,(m->nULCol+m->nWidth))
   endif

   define window wCheck from m->nULRow, m->nULCol to m->nBRRow,;
                                        m->nBRCol double color &cColor.
   activate screen
   do shadow with m->nULRow,m->nULCol,m->nBRRow,m->nBRCol
   activate window wCheck

   *-- paint screen
   do center with 0,m->nWidth,"",m->cTitle
   store 1 to m->nCnt
   do while m->nCnt <= m->nHeight
      store "cTxt"+str(m->nCnt,1) to m->cStr
      store "lChk"+str(m->nCnt,1) to cChk
      @m->nCnt+1,2 say "["+iif(&cChk.,"X"," ")+"]" color &cMidCol.
      @m->nCnt+1,6 say left(&cStr.,m->nWidth-9)
      m->nCnt = m->nCnt + 1
   enddo
   do center with m->nCnt+2,m->nWidth,"",m->cPrompt

   *-- prepare for and get nChoice
   store 1 to m->nCnt
   store .F. to m->lDone
   do while .not. m->lDone
      store "lChk"+str(m->nCnt,1) to m->cChk
      @ m->nCnt+1,3 say "" color &cMidCol.
      m->nKey = inkey(0)
      do case
         case m->nKey = 27                   && Press Esc to exit
            m->nCnt = 0
            do while m->nCnt < m->nHeight
               m->nCnt = m->nCnt + 1
               m->cCnt = str(m->nCnt,1)
               store lOrig&cCnt. to lChk&cCnt.
            enddo
            store .T. to m->lDone
         case m->nKey = 13                && Press Enter when finished
            store .T. to m->lDone
         case m->nKey = 32                && Press Space
               set cursor off
               if &cChk.                  && Box was already selected,
                  @ m->nCnt+1,3 say " " color &cMidCol.
                                          && so now de-select it
                  store .F. to &cChk.
               else                     && Box was not already selected,
                  @ m->nCnt+1,3 say "X" color &cMidCol.
                                        && so now select it
                  store .T. to &cChk.
               endif
               set cursor on
         case m->nKey = 5               && Press up arrow
            if m->nCnt > 1
               m->nCnt = m->nCnt - 1
            else
               m->nCnt = m->nHeight
            endif
         case m->nKey = 24              && Press down arrow
            if m->nCnt < m->nHeight
               m->nCnt = m->nCnt + 1
            else
               m->nCnt = 1
            endif
      endcase
   enddo

   *-- Cleanup
   release window wCheck
   restore screen from sCheck
   release screen sCheck
   set message to
   set cursor &cCursor.

RETURN
*-- EoP: ChkBox

PROCEDURE MultiPick
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/06/1993
*-- Notes.......: Permits selecting 0 or more elements of an array.
*--               The array must contain two columns, the first of which
*--               contains the prompt for the row and the second of
*--               which contains logical .T. if the row is selected by
*--               default, or .F.  Array may contain additional columns.
*--                     This is written for programmers, not end users.
*--               It assumes the active window and border style are set
*--               before it is called, and no error handling is provided
*--               for attempts to write outside the current window,
*--               impossible colors, truncation of prompts or other
*--               calling errors that should become evident on testing.
*--
*--               If array contains elements "Hydrangea",.T. and
*--               "Tulip",.F., initial display after setting a window
*--               and calling will be something like this:
*--
*--                  [ ˚ ] Hydrangea
*--                  [   ] Tulip
*--
*--               This program will use the mouse if two conditions
*--               exist:
*--                 1) The variable nG_MusClic must exist and must hold
*--                    the inkey() value of the character "keyboarded"
*--                    for a click by the mouse-event handler.  Note
*--                    that this is often, but need not be, the same as
*--                    asc( <character> ).
*--                 2) The mouse must be made active and visible by a
*--                    mouse-control .bin such as JPMOUSE.BIN and
*--                    MUSCLICK.BIN must be loaded and installed.
*--               *******************************
*--               **** REQUIRES MUSCLICK.BIN ****
*--               ****          JPMOUSE.BIN  ****
*--               ****          VDCURSOR.BIN ****
*--               *******************************
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 01/16/93 - original procedure
*--               02/06/93 - revised to use cWnSize, etc.
*--               02/24/93 - parameters changed, functions called moved
*--                          out
*--               02/28/93 - symbolic constants and support for tab
*--                          added
*-- Calls.......: SMultPick         Child procedure to paint screen
*--               Arrayrows()       Function in Array.prg
*--               MUSCLICK.BIN      Binary mouse-event handler
*--               CWnSize()         Function to find window size
*--               CWnDecode()       Function to decode the above
*--               YnMouse()         Yesno function for mouse
*--               NormColors()      Function to return normal colors
*--               HighColors()      Function to return highlight colors
*--               ForeColor()       Function to return foreground color
*--
*-- Called by...: Any
*-- Usage.......: DO Multipick WITH <cArray>,<nDown>,<nLast>,<nRows>,;
*--                                 <nLength>[, <cColors> [, <cCheck>]]
*-- Example.....: DO Multipick WITH "Myarray",3,15,10,18,"RG+/G,N/W",;
*--                                 chr(2)
*-- Parameters..: cArray      = Name of the array of selectable items.
*--                             See Notes, above, for required
*--                             structure.
*--               nDown       = first useable row of window
*--               nLast       = last useable row of window
*--               nRows       = number of items to show on screen at
*--                             once
*--               nLength     = maximum length of prompts
*--               cColors     = optional, colors to use for
*--                             noncurrent and current items.
*--                             Default is NORMAL and HIGHLIGHT colors
*--                             for the current window.
*--                             Pass default as .F. if cCheck is
*--                             included.
*--               cCheck      = optional, character to use to show
*--                             selection. Default is "˚".  See
*--                             "cBox" variables in the procedure for
*--                             bracketing characters.
*-- Also uses...: global numeric variable nG_MusClic, giving the inkey()
*--               value of the character "keyboarded" by a mouse click.
*--               If this variable does not exist, mouse support is
*--               absent.
*-- Side effects: On return, the values of the second column of the
*--               array are .T. or .F. in accordance with selections
*--               made.
*-- Special note: The CWnSize function called by this routine uses
*--               VDCURSOR.BIN, which must be available for this routine
*--               to work, and disables any ON ERROR trap.
*-----------------------------------------------------------------------

   parameters cArray, nDown, nLast, nRows, nLength, cColors, cCheck
   private cChar, cCols, cNorm, cHigh, nAt, nTop, nKey, cBoxl, ;
           cBoxr
   private nElems, lGotMouse, nMTop, nMBot, nMLeft, nMRight, cCols
   private cMrow, cMcol, nMrow, nMcol, cEsc, cWin, nWinTop, ;
           nWinLeft
   private nWinBot, nWinRight, nK, cK, cTemp, nX, cQuit, nRo, ;
           lOnPicks, lOk

   *  These "symbolic constants" are C-style, just to avoid "magic
   *  numbers" scattered throughout the routine.  Of course, they
   *  may also slow it down absent a true compiler
   private NBOXLEN, NEXTRAROWS, NPADLEN, NTWOPADS
   m->nBoxLen    =  6    && length of the "[ ˚ ] " structure
   m->nExtraRows =  4    && blank row at top, 3 rows for quit pads
   m->nPadLen    =  6    && length of the OK and Cancel pads
   m->nTwoPads   = 13    && length of two pads and a space between

   * set escape
   cEsc = set("ESCAPE")
   set escape off

   * set delimiter chars
   m->cBoxL = "[ "
   m->cBoxR = " ] "

   * set colors if specified
   if type( "cColors" ) = "C"
      m->cCols = m->cColors
   else
      m->cCols = set( "ATTRIBUTES" )
      m->cCols = left( m->cCols, at( "&", m->cCols ) - 2 )
   endif
   m->cNorm = NormColors( m->cCols )
   m->cHigh = HighColors( m->cCols )
   * set up quit pad colors
   m->cQuit = m->cHigh

   * set checkmark char, default is "˚" ( chr( 251 ) )
   m->cChar = iif( type( "cCheck" ) # "L", m->cCheck, "˚" )

   * calculate array rows and set up temporary array for restoration
   m->nElems = arrayrows( m->cArray )
   declare cTemp[ m->nElems ]
   m->nX = 1
   do while m->nX <= m->nElems
      cTemp[ m->nX ] = &cArray.[ m->nX, 2 ]
      m->nX = m->nX + 1
   enddo

   *  find borders of current window and determine centering offset
   m->cWin = cWnSize()
   if len( m->cWin ) > 0
      m->nWinTop   = cWnDecode( m->cWin, "T" )
      m->nWinLeft  = cWnDecode( m->cWin, "L" )
      m->nWinBot   = cWnDecode( m->cWin, "B" )
      m->nWinRight = cWnDecode( m->cWin, "R" )
   else
      activate screen
      ? "Can't find VDCURSOR.BIN - aborting"
      wait
      cancel
   endif
   m->nRight = int( ( m->nWinRight - m->nWinLeft - m->nBoxLen - ;
                      m->nLength ) / 2 )
   m->nCkCol = m->nRight + 2

   *  we need at least 13 columns for the quit pads, and enough for
   *  the checkbox table itself
   if m->nWinRight - m->nWinLeft < max( m->nTwoPads, ;
                     m->nBoxLen + m->nLength )
      activate screen
      ? "Too few columns in this window - aborting"
      wait
      cancel
   endif

   *  determine rows to use if window is small
   m->nRo = min( m->nRows, min( m->nLast - m->nDown,;
                 m->nWinBot - m->nWinTop - m->nExtraRows ) )
   if m->nRo < 1
      activate screen
      ? "Too few rows in this window - aborting"
      wait
      cancel
   endif

   * test for mouse support and set boundaries of active click area
   * nMx variables represent absolute screen positions of the edges
   * of the checkbox table
   m->lGotMouse = .F.
   if type( "nG_MusClick" ) = "N"
      m->lGotMouse = .T.
      m->nMTop   = m->nWinTop +  m->nDown - 1    && row above table
      m->nMLeft  = m->nWinLeft + m->nRight       && left edge of table
      m->nMBot   = m->nMTop + m->nRo + 1         && row below table
      m->nMRight = m->nMLeft + m->nBoxLen + m->nLength - 1 && right edge
   endif

   * position quit pads ( they are displayed by Smultpick )
   * nLpad and nRpad are column offsets within the active window
   * of the two pads, "  OK  " and "Cancel"
   if m->nPadLen + m->nLength > m->nTwoPads
      m->nLPad = m->nRight
   else
      m->nLPad = int( ( m->nWinRight - m->nWinLeft ) / 4 ) - ;
                      ( m->nPadLen / 2 )
   endif
   m->nRPad = m->nWinRight - m->nWinLeft - m->nPadLen - m->nLPad

   * initialize display as if "Home" had been pressed
   * nTop is the index into the array of the element to be shown
   *   on the top row of the table
   * nHigh is the index into the array of the element to be shown
   *   highlighted ( the current element )
   * lOnPicks is the "focus"; .T. means we are in the pick table,
   *   not on the quit pads
   m->nTop = 1
   m->nHigh = m->nTop
   keyboard "{Home}"
   m->lOnPicks = .T.

   * commence main key-handling loop
   do while .T.
      m->nKey = inkey()
      if m->nKey = 0
         loop
      endif
      do case
         case m->nKey = 23      && Ctrl-End
            exit
         case m->nKey = 27      && Escape
            if YesQuit()
               exit
            endif
         case m->nKey = 79 .or. m->nKey = 111   && 'O' or 'o'
            exit
         case m->nKey = 67 .or. m->nKey = 99    && 'C' or 'c'
            if YesQuit()
               exit
             endif
         case m->nKey = 9                    && Tab
            if m->lOnPicks
               lOk = .T.                    && default tab is "OK"
               @ row(), m->nRight say m->cBoxL + ;
                    iif( &cArray.[ m->nHigh, 2], ;
                    m->cChar, " " ) + m->cBoxR color &cNorm.
               @ row(), col() say left( &cArray.[ m->nHigh, 1 ] ;
                   + space( m->nLength ), m->nLength ) color &cNorm.
               @ m->nLast, m->nLPad + m->nPadLen / 2 say ""
            else
               do SmultPick
            endif
            m->lOnPicks = .not. m->lOnPicks
         case m->lGotMouse .and. m->nKey = nG_MusClick  && mouse click
            store chr(255) to m->cMRow, m->cMCol
            call MUSCLICK with m->cMRow, m->cMCol
            m->nMRow = asc( m->cMRow )
            m->nMCol = asc( m->cMCol )
            if m->nMRow >= m->nMTop .and. m->nMRow <= m->nMBot .and. ;
               m->nMCol >= m->nMLeft .and. m->nMCol <= m->nMRight
                                                       && in active area
               m->nAt = m->nHigh - m->nTop + m->nMTop + 1
               do case
                  case m->nMRow = m->nAt
                     keyboard chr( 13 )
                  case m->nMRow = m->nMTop
                     keyboard "{PgUp}"
                  case m->nMRow = m->nMBot
                     keyboard "{PgDn}"
                  case m->nMRow > m->nAt
                     do while m->nAt < m->nMRow
                        keyboard "{DNARROW}"
                        m->nAt = m->nAt + 1
                     enddo
                  case m->nMRow < m->nAt
                     do while m->nAt > m->nMRow
                        keyboard "{UPARROW}"
                        m->nAt = m->nAt - 1
                     enddo
               endcase
            else
               * if it was on a pad
               if m->nMRow = m->nWinTop + m->nLast
                  if m->nMCol >= m->nWinLeft + m->nLPad .and. ;
                     m->nMCol < m->nWinLeft + ;
                     m->nLPad + m->nPadLen
                    keyboard "O"
                    loop
                  endif
                  if m->nMCol >= m->nWinLeft + m->nRPad .and.;
                     m->nMCol < m->nWinLeft + ;
                     m->nRPad + m->nPadLen
                    keyboard "C"
                    loop
                  endif
               endif
               keyboard "{Esc}"
            endif
         otherwise
            if m->lOnPicks
               do case
                  case m->nKey = 26      && Home
                     m->nTop = 1
                     m->nHigh = m->nTop
                     do SMultPick
                  case m->nKey = 2       && End
                      m->nTop = m->nElems - m->nRo + 1
                      m->nHigh = m->nElems
                      do SMultPick
                  case m->nKey = 24        && down arrow
                      if m->nHigh = m->nTop + m->nRo - 1 .or. ;
                         m->nHigh = m->nElems
                         keyboard "{PgDn}"
                       else
                          @ m->nHigh - m->nTop + m->nDown,;
                            m->nRight say ""
                          @ row(), m->nRight say m->cBoxL + ;
                            iif( &cArray.[ m->nHigh, 2], ;
                            m->cChar, " " ) + m->cBoxR color &cNorm.
                          @ row(), col() say ;
                            left( &cArray.[ m->nHigh, 1 ] ;
                            + space( m->nLength ), m->nLength ) ;
                            color &cNorm.
                          m->nHigh = m->nHigh + 1
                          @ row() + 1, m->nRight say m->cBoxL + ;
                            iif( &cArray.[ m->nHigh, 2], ;
                            m->cChar, " " ) +m->cBoxR color &cHigh.
                          @ row(), col() say ;
                            left( &cArray.[ m->nHigh, 1 ] ;
                            + space( m->nLength ), m->nLength );
                            color &cHigh.
                          @ row(), m->nCkCol say ""
                       endif
                  case m->nKey = 5         && up arrow
                     if m->nHigh = m->nTop
                        keyboard "{PgUp}"
                     else
                        @ m->nHigh - m->nTop + m->nDown, ;
                          m->nRight say ""
                        @ row(), m->nRight say m->cBoxL + ;
                          iif( &cArray.[ m->nHigh, 2], ;
                          m->cChar, " " ) + m->cBoxR color &cNorm.
                        @ row(), col() say ;
                          left( &cArray.[ m->nHigh, 1 ] ;
                          + space( m->nLength ), m->nLength );
                          color &cNorm.
                        m->nHigh = max( 1, m->nHigh - 1 )
                        @ row() - 1, m->nRight say m->cBoxL +;
                          iif( &cArray.[ m->nHigh, 2], ;
                          m->cChar, " " ) + m->cBoxR color &cHigh.
                        @ row(), col() say ;
                          left( &cArray.[ m->nHigh, 1 ] ;
                          + space( m->nLength ), m->nLength );
                          color &cHigh.
                        @ row(), m->nCkCol say ""
                     endif
                   case m->nKey = 32 .or. m->nKey = 13
                                       && space and enter are toggles
                     &cArray.[ m->nHigh, 2 ] = .not. ;
                                        &cArray[ m->nHigh, 2 ]
                     @ row(), m->nCkCol say ;
                       iif( &cArray.[ m->nHigh, 2], m->cChar, " " ) ;
                       color &cHigh.
                     @ row(), m->nCkCol say ""
                  case m->nKey = 3      && PgDn
                     if m->nHigh = m->nTop + m->nRo - 1 .or.;
                        m->nHigh = m->nElems
                        m->nTop = min( m->nHigh, m->nElems - ;
                                       m->nRows + 1 )
                        do SmultPick
                     else
                        @ row(), m->nRight say m->cBoxL +;
                          iif( &cArray.[ m->nHigh, 2], ;
                          m->cChar, " " ) + m->cBoxR color &cNorm.
                        @ row(), col() say left( &cArray.[ m->nHigh, 1];
                           + space( m->nLength ), m->nLength );
                           color &cNorm.
                        m->nHigh = m->nTop + m->nRo - 1
                        @ m->nDown + m->nRo - 1, m->nRight say ""
                        @ row(), m->nRight say m->cBoxL + ;
                          iif( &cArray.[ m->nHigh, 2], ;
                          m->cChar, " " ) + m->cBoxR color &cHigh.
                        @ row(), col() say left( &cArray.[ m->nHigh, 1];
                           + space( m->nLength ), m->nLength ) ;
                           color &cHigh.
                        @ row(), m->nCkCol say ""
                     endif
                  case m->nKey = 18      && PgUp
                     if m->nHigh = m->nTop
                        m->nTop = max( 1, m->nHigh - m->nRo + 1 )
                        do SmultPick
                     else
                        m->nHigh = m->nTop
                        @ m->nDown, m->nRight say ""
                        @ row(), m->nRight say m->cBoxL +;
                          iif( &cArray.[ m->nHigh, 2], ;
                          m->cChar, " " ) + m->cBoxR color &cHigh.
                        @ row(), col() say left( &cArray.[ m->nHigh, 1];
                           + space( m->nLength ), m->nLength ) ;
                           color &cHigh.
                        @ row(), m->nCkCol say ""
                     endif
               endcase
            else
               do case
                  case m->nKey = 32 .or. m->nKey = 4 .or. m->nKey = 19
                                           && space, r & l
                     m->lOK = .not. m->lOK
                     @ m->nLast, iif( m->lOK, m->nLPad, m->nRPad );
                       + m->nPadLen / 2 say ""
                  case m->nKey = 13        && and enter quits
                     if m->lOK
                        keyboard "{CTRL-END}"
                     else
                        keyboard "{ESC}"
                     endif
               endcase
            endif
         endcase
      enddo

      if m->cEsc ="ON"
         set escape on
      endif

RETURN
*-- EoP: MultiPick

FUNCTION CheckBox2
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
*-- Date........: 06/01/1992
*-- Notes.......: This routine brings up a one-line message, allows the
*--               user to click mouse/press <Space> on it, to change
*--               status. Pressing <Enter>/<Esc> chooses the current
*--               setting ...
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: CheckBox2(<lVar>,"<cTitle>",<nRow>,<nCol>,<nASCII>)
*-- Example.....: lX = CheckBox2(.t.,"OK as is?",9,10,4)
*-- Returns.....: Logical
*-- Parameters..: lVar     = On or Off to start? (.t.=on, .f.=off)
*--               cTitle   = Title/Message
*--               nRow     = Row to place this
*--               nCol     = Column ...
*--               nASCII   = ascii character to use in box. (Optional)
*--                          Default is 251 (˚). Other suggestions
*--                          include:
*--                          4 (diamond), 176 (∞), 177 (±), 178 (≤),
*--                          219 (€), 249 (˘), 250 (˙), 254 (˛)
*--                          (Check out the ASCII chart in the
*--                          language ref.)
*-----------------------------------------------------------------------

   parameters lVar, cTitle, nRow, nCol, nASCII

   *-- if parameter is left blank, assign 251 (˚)
   m->nASCII = iif(pCount() = 5, m->nASCII, 251)

   define menu mCheck

   *-- loop until user does something, or presses <Esc>
   do while .t.

      *-- define the menu pad ...
      define pad pCheck1 of mCheck at m->nRow,m->nCol prompt;
         "["+iif(m->lVar,chr(m->nASCII)," ")+"] "+m->cTitle
      on selection pad pCheck1 of mCheck deactivate menu

      *-- when user presses <Enter> turn it all off ... (send <Esc> ...)
      on key label ctrl-m keyboard "{27}"

      *-- start 'er up
      activate menu mCheck

      *-- (<Esc> or <Enter>)
      if lastkey() = 27
         exit
      endif

      m->lVar = .not. m->lVar   && set to opposite of current setting

   enddo

   *-- reset environment/release things
   on key label ctrl-m
   release menu mCheck

RETURN m->lVar
*-- EoF: CheckBox2()

Function CheckBx1
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
*-- Date........: 06/01/1992
*-- Notes.......: This routine brings up a one-line message, allows the
*--               user to click mouse/press <Space> on it, to change
*--               status. Pressing <Enter>/<Esc> chooses the current
*--               setting ...
*--               This one is different, in that it does not use a menu
*--               to accomplish it's ends, but uses instead a memvar,
*--               with @/GET/READ and a picture using the multiple
*--               choice ("@M") function.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/01/1992 -- Original
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: CheckBx1(<lVar>,"<cTitle>",<nRow>,<nCol>)
*-- Example.....: lX = CheckBx1(.t.,"OK as is?",9,10)
*-- Returns.....: Logical
*-- Parameters..: lVar     = On or Off to start? (.t.=on, .f.=off)
*--               cTitle   = Title/Message
*--               nRow     = Row to place this
*--               nCol     = Column ...
*-----------------------------------------------------------------------

   parameters lVar, cTitle, nRow, nCol

   *-- save parts of environment ...
   m->cFormat = set("FORMAT")
   set format to
   m->cCursor = set("CURSOR")
   set cursor off

   *-- define starting value of cVar ...
   *-- (this is ASCII 255, ˚, ASCII 255, if lVar = .t., 3 spaces
   *-- if lVar = .f.)
   m->cVar = iif(m->lVar,chr(255)+chr(251)+chr(255),space(3))

   *-- display/get, using picture
   @m->nRow,m->nCol get m->cVar picture "@M ,ˇ˚ˇ"

   *-- this picture is: space, comma, chr(255), chr(251), chr(255).
   @m->nRow,m->nCol + 4 say m->cTitle

   READ

   *-- reset environment
   set format to &cFormat.
   set cursor &cCursor.

RETURN .not. (m->cVar = chr(32))   && not a space
*-- EoF: CheckBx1()

FUNCTION RadioBut
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
*-- Date........: 06/01/1992
*-- Notes.......: This is a Radio Button routine.  NOTE that the array
*--               called as cArray below must be a character array (i.e.
*--               all data must be character data ...).
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/01/1992 -- Original
*-- Calls.......: ArrayRows()          Function in WINDOWS.PRG
*--               TmpRadio             Procedure in WINDOWS.PRG
*-- Called by...: None
*-- Usage.......: RadioBut("<cArray>",<nRow>,<nCol>,<nDefPad>,<nASCII>)
*-- Example.....: nReturn =  RadioBut("aTest",5,10,1,15)
*-- Returns.....: Numeric (Array Index of item selected)
*-- Parameters..: cArray  = Name of Array (Character data)
*--               nRow    = Row for coordinates ... (start position)
*--               nCol    = Column for same
*--               nDefPad = Default Pad number
*--               nASCII  = ASCII character to use as 'button'
*--                        (Optional ...)
*--                   try: 4 (Diamond), 9 (Circle), 15 (splot), 42 (*),
*--                        249 (˘),  251 (˚) or 254 (˛) ...
*-----------------------------------------------------------------------

   parameters cArray, nRow, nCol, nDefPad, nASCII

   define menu mRadio
   public aTmpRadio, nARows, nPad

   *-- get number of items to display
   m->nARows = ArrayRows(m->cArray)

   *-- set character for 'button'
   m->nASCII = iif(PCOUNT() <= 4,4,m->nASCII) && default is a 'diamond'

   *-- start definitions ...
   m->cPad = iif(pcount() => 4 .and. m->nDefPad # 0,;
                                     ltrim(str(m->nDefPad)),"1")
   m->nCol = iif(pcount() <= 2,10,m->nCol)
   m->nRow = iif(pCount() <= 1,5,m->nRow)

   *-- here we get the largest item in the array ...
   m->nX = 1
   m->nLongest = 1
   do while m->nX <= m->nARows
      m->nLongest = max(m->nLongest,len(trim(&cArray.[m->nX])))
      m->nX = m->nX + 1
   enddo

   *-- define a temporary array ...
   declare aTmpRadio[m->nARows]

   on key label ctrl-m keyboard "{27}"  && close down if <Enter> ...

   m->cX = "1"
   do while .t.

      *-- define menu pads
      do while val(m->cX) <= m->nARows
         define pad button&cX. of mRadio at m->nRow - 1 + ;
            val(m->cX),m->nCol;
            prompt "("+ iif(aTmpRadio[val(m->cX)] .or. m->cPad = m->cX,;
            chr(m->nASCII)," ")+") "+trim(&cArray[val(m->cX)])+;
            space(m->nLongest-len(trim(&cArray[val(m->cX)])))
         on selection pad button&cX. of mRadio deactivate menu
         m->cX = ltrim(str(val(m->cX)+1))
      enddo

      *-- start 'er up
      activate menu mRadio pad button&nPad.
      *-- if <Esc> (or <Enter>), we're done ...
      if lastkey() = 27
         nPad = substr(pad(),7)
         exit
      else
         *-- if not, perform routine below to reset the temp array ...
         do TmpRadio
      endif
   enddo

   *-- cleanup
   on key label ctrl-m
   m->nY = 1
   do while m->nY <= m->nARows .and. .not. aTmpRadio[m->nY]
      m->nY = m->nY + 1
   enddo
   release aTmpRadio, nPad
   release menu mRadio

RETURN iif(m->nY > m->nARows, 0, m->nY)
*-- EoF: RadioBut()

PROCEDURE TmpRadio
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
*-- Date........: 06/01/1992
*-- Notes.......: Used to set/reset the temporary array aTmpRadio[] for
*--               use in the RadioBut() function above.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 06/01/1992 -- Original
*-- Calls.......: None
*-- Called by...: RadioBut()           Function in WINDOWS.PRG
*-- Usage.......: Do TmpRadio
*-- Example.....: Do TmpRadio
*-- Returns.....: None
*-- Parameters..: None
*-----------------------------------------------------------------------

   m->nPad = substr(pad(),7)
   m->nY = 1
   do while m->nY <= m->nARows
      aTmpRadio[m->nY] = .f.
      m->nY = m->nY + 1
   enddo
   aTmpRadio[val(m->nPad)] = .t.
   m->cX = "1"

RETURN
*-- EoP: TmpRadio

PROCEDURE BORD3D
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 03/15/1993
*-- Notes.......: Designed to take a dialog box that _doesn't_ have a
*--               border defined (NONE), and is a grey box (i.e.,
*--               background is 'W' for color) and give a 3-d border
*--               to it ...
*--               ASSUMPTION: Dialog box is defined in a window ... (not
*--               using @...FILL TO ... command)
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 03/15/1993 -- Original
*-- Calls.......: COLORBRK()           Function in PROC.PRG
*--               BackColor()          Function in COLOR.PRG
*-- Called by...: Any (Specifically YESNO4())
*-- Usage.......: Do Bord3D with <m->nHeight>,<nWidth>,<cColor>,<nStyle>
*-- Example.....: Do Bord3D with 9,40,cWind1,2
*-- Returns.....: None
*-- Parameters..: nHeight  = height of dialog box
*--               nWidth   = Width of dialog box
*--               cColor   = Color settings used for dialog box --
*--                          requires at a minimum the colors for the
*--                          text part (i.e, "rg+/r")
*--               nStyle   = 'Style' of border -- 1 = raised, 2 = inset
*-----------------------------------------------------------------------

   parameters nHeight, nWidth, cColor, nStyle
   private nHeight2, nWidth2

   m->cBorder = set("BORDER")       && save border setting
   set border to single             && must be single for this ...

   *-- figure out colors
   m->cTextColor = colorbrk(m->cColor,1)
   m->cBackColor = backcolor(m->cTextColor)
   m->cHighColor = "W+/"+m->cBackColor
   m->cShadColor = "N/"+m->cBackColor

   *-- if style is 1, we do the commands for a 'raised' border
   *-- if style is 2, we do an 'inset' border
   if m->nStyle < 1 .or. m->nStyle > 2  && if not 1 or 2 ...
      m->nStyle = 1
   endif

   if m->nStyle = 1
      *-- Outside of "border"
      @0,0 to 0,m->nWidth                    color &cHighColor.
      @0,0 to m->nHeight, 0                  color &cHighColor.
      @0,0       say chr(218)                color &cHighColor.
      @m->nHeight,0 say chr(192)             color &cHighColor.
      @0,m->nWidth   to m->nHeight,m->nWidth color &cShadColor.
      @m->nHeight, 1 to m->nHeight,m->nWidth color &cShadColor.
      @0,m->nWidth say chr(191)              color &cShadColor.
      @m->nHeight,m->nWidth say chr(217)     color &cShadColor.
      *-- inside of "border"
      m->nWidth2 = m->nWidth - 2
      m->nHeight2 = m->nHeight - 1
      @1,2 to 1,m->nWidth2                     color &cShadColor.
      @1,2 to m->nHeight2,2                    color &cShadColor.
      @1,2 say chr(218)                        color &cShadColor.
      @m->nHeight2,2 say chr(192)              color &cShadColor.
      @1,m->nWidth2 to m->nHeight2,m->nWidth2  color &cHighColor.
      @m->nHeight2,3 to m->nHeight2,m->nWidth2 color &cHighColor.
      @1,m->nWidth2 say chr(191)               color &cHighColor.
      @m->nHeight2,m->nWidth2 say chr(217)     color &cHighColor.

   else

      *-- Outside of "border"
      @0,0 to 0,m->nWidth                     color &cShadColor.
      @0,0 to m->nHeight, 0                   color &cShadColor.
      @0,0       say chr(218)                 color &cShadColor.
      @m->nHeight,0 say chr(192)              color &cShadColor.
      @0,m->nWidth   to m->nHeight,m->nWidth  color &cHighColor.
      @m->nHeight, 1 to m->nHeight,m->nWidth  color &cHighColor.
      @0,m->nWidth say chr(191)               color &cHighColor.
      @m->nHeight,m->nWidth say chr(217)      color &cHighColor.

      *-- inside of "border"
      m->nWidth2 = m->nWidth - 2
      m->nHeight2 = m->nHeight - 1
      @1,2 to 1,m->nWidth2                     color &cHighColor.
      @1,2 to m->nHeight2,2                    color &cHighColor.
      @1,2 say chr(218)                        color &cHighColor.
      @m->nHeight2,2 say chr(192)              color &cHighColor.
      @1,m->nWidth2 to m->nHeight2,m->nWidth2  color &cShadColor.
      @m->nHeight2,3 to m->nHeight2,m->nWidth2 color &cShadColor.
      @1,m->nWidth2 say chr(191)               color &cShadColor.
      @m->nHeight2,m->nWidth2 say chr(217)     color &cShadColor.

   endif

   *-- reset border
   set border to &cBorder.

RETURN
*-- EoP: Bord3D

PROCEDURE Bord3D2
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 03/18/1993
*-- Notes.......: This variation on BORD3D was written to deal with
*--               items that are "filled", rather than windows, that
*--               have a set edge. This one requires that the actual
*--               coordinates get passed to it.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 03/18/1993 -- Original
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Do Bord3D2 with <nTop>,<nLeft>,<nBottom>,<nRight>,;
*--                               <cColor>,<nStyle>
*-- Example.....: Do Bord3d2 with 0,15,4,60,cColor,1
*-- Returns.....: None
*-- Parameters..: nTop    = top row
*--               nLeft   = Left column
*--               nBottom = Bottom Row
*--               nRight  = Right Column
*--               cColor  = Color of area being filled
*--               nStyle  = type of 3-d border (1 = Raised, 2 = Inset)
*-----------------------------------------------------------------------

   parameters nTop,nLeft,nBottom,nRight,cColor,nStyle

   *-- deal with border ...
   *-- figure out colors
   m->cBackColor = backcolor(m->cColor)
   m->cHighColor = "W+/"+m->cBackColor
   m->cShadColor = "N/"+m->cBackColor

   *-- if style is 1, we do the commands for a 'raised' border
   *-- if style is 2, we do an 'inset' border
   if m->nStyle < 1 .or. m->nStyle > 2  && if not 1 or 2 ...
      m->nStyle = 1
   endif

   if m->nStyle = 1
      *-- RAISED Border
      *-- Outside of "border"
      @m->nTop,m->nLeft to m->nTop,m->nRight         color &cHighColor.
      @m->nTop,m->nLeft to m->nBottom,m->nLeft       color &cHighColor.
      @m->nTop,m->nLeft say chr(218)                 color &cHighColor.
      @m->nBottom,m->nLeft say chr(192)              color &cHighColor.
      @m->nTop,m->nRight to m->nBottom,m->nRight     color &cShadColor.
      @m->nBottom,m->nLeft+1 to m->nBottom,m->nRight color &cShadColor.
      @m->nTop,m->nRight say chr(191)                color &cShadColor.
      @m->nBottom,m->nRight say chr(217)             color &cShadColor.

      *-- inside of "border"
      @m->nTop+1,m->nLeft+2 to m->nTop+1,m->nRight-2 color &cShadColor.
      @m->nTop+1,m->nLeft+2 to m->nBottom-1,m->nLeft+2 ;
                                                     color &cShadColor.
      @m->nTop+1,m->nLeft+2 say chr(218)             color &cShadColor.
      @m->nBottom-1,m->nLeft+2 say chr(192)          color &cShadColor.
      @m->nTop+1,m->nRight-2 to m->nBottom-1,m->nRight-2;
                                                     color &cHighColor.
      @m->nBottom-1,m->nLeft+3 to m->nBottom-1,m->nRight-2;
                                                     color &cHighColor.
      @m->nTop+1,m->nRight-2 say chr(191)            color &cHighColor.
      @m->nBottom-1,m->nRight-2 say chr(217)         color &cHighColor.

   else
      *-- RECESSED Border
      *-- Outside of "border"
      @m->nTop,m->nLeft to m->nTop,m->nRight         color &cShadColor.
      @m->nTop,m->nLeft to m->nBottom,m->nLeft       color &cShadColor.
      @m->nTop,m->nLeft say chr(218)                 color &cShadColor.
      @m->nBottom,m->nLeft say chr(192)              color &cShadColor.
      @m->nTop,m->nRight to m->nBottom,m->nRight     color &cHighColor.
      @m->nBottom,m->nLeft+1 to m->nBottom,m->nRight color &cHighColor.
      @m->nTop,m->nRight say chr(191)                color &cHighColor.
      @m->nBottom,m->nRight say chr(217)             color &cHighColor.

      *-- inside of "border"
      @m->nTop+1,m->nLeft+2 to m->nTop+1,m->nRight-2  color &cHighColor.
      @m->nTop+1,m->nLeft+2 to m->nBottom-1,m->nLeft+2;
                                                      color &cHighColor.
                                                      color &cHighColor.
      @m->nBottom+1,m->nLeft+2 say chr(192)           color &cHighColor.
      @m->nTop+1,m->nRight-2 to m->nBottom-1,m->nRight-2;
                                                      color &cShadColor.
      @m->nBottom-1,m->nLeft+3 to m->nBottom-1,m->nRight-2 ;
                                                      color &cShadColor.
      @m->nTop+1,m->nRight-2 say chr(191)             color &cShadColor.
      @m->nBottom-1,m->nRight-2 say chr(217)          color &cShadColor.

   endif

   *-- reset border
   set border to &cBorder.

RETURN
*-- EoP: Bord3D2

PROCEDURE Bord3D3
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 05/07/1993
*-- Notes.......: Designed to take a dialog box that _doesn't_ have a
*--               border defined (NONE) and give a 3-d border to it ...
*--               ASSUMPTION: Dialog box is defined in a window ... (not
*--               using @...FILL TO ... command)
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 03/15/1993 -- Original
*--               05/07/1993 -- Version to give a single-line border
*-- Calls.......: COLORBRK()           Function in PROC.PRG
*--               BackColor()          Function in COLOR.PRG
*-- Called by...: Any (Specifically YESNO4())
*-- Usage.......: Do Bord3D3 with <nHeight>,<nWidth>,<cColor>,;
*--                               <nStyle>
*-- Example.....: Do Bord3D3 with 9,40,cWind1,2
*-- Returns.....: None
*-- Parameters..: nHeight  = height of dialog box
*--               nWidth   = Width of dialog box
*--               cColor   = Color settings used for dialog box --
*--                          requires at a minimum the colors for the
*--                          text part (i.e, "rg+/r")
*--               nStyle   = 'Style' of border -- 1 = raised, 2 = inset
*-----------------------------------------------------------------------

   parameters nHeight, nWidth, cColor, nStyle
   private nHeight2, nWidth2

   m->cBorder = set("BORDER")    && save border setting
   set border to single          && must be single for this ...

   *-- figure out colors
   m->cTextColor = colorbrk(m->cColor,1)
   m->cBackColor = backcolor(m->cTextColor)
   m->cHighColor = "W+/"+m->cBackColor
   m->cShadColor = "N/"+m->cBackColor

   *-- if style is 1, we do the commands for a 'raised' border
   *-- if style is 2, we do an 'inset' border
   if m->nStyle < 1 .or. m->nStyle > 2  && if not 1 or 2 ...
      m->nStyle = 1
   endif

   if m->nStyle = 1
      *-- Outside of "border"
      @0,0 to 0,m->nWidth                    color &cHighColor.
      @0,0 to m->nHeight, 0                  color &cHighColor.
      @0,0       say chr(218)                color &cHighColor.
      @m->nHeight,0 say chr(192)             color &cHighColor.
      @0,m->nWidth   to m->nHeight,m->nWidth color &cShadColor.
      @m->nHeight, 1 to m->nHeight,m->nWidth color &cShadColor.
      @0,m->nWidth say chr(191)              color &cShadColor.
      @m->nHeight,m->nWidth say chr(217)     color &cShadColor.

   else

      *-- Outside of "border"
      @0,0 to 0,m->nWidth                    color &cShadColor.
      @0,0 to m->nHeight, 0                  color &cShadColor.
      @0,0       say chr(218)                color &cShadColor.
      @m->nHeight,0 say chr(192)             color &cShadColor.
      @0,m->nWidth   to m->nHeight,m->nWidth color &cHighColor.
      @m->nHeight, 1 to m->nHeight,m->nWidth color &cHighColor.
      @0,m->nWidth say chr(191)              color &cHighColor.
      @m->nHeight,m->nWidth say chr(217)     color &cHighColor.

   endif

   *-- reset border
   set border to &cBorder.

RETURN
*-- EoP: Bord3D3

PROCEDURE Bord3D4
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 05/07/1993
*-- Notes.......: This variation on BORD3D was written to deal with
*--               items that are "filled", rather than windows, that
*--               have a set edge. This one requires that the actual
*--               coordinates get passed to it. This one is a single-
*--               line version of BORD3D2.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 03/18/1993 -- Original
*--               05/07/1993 -- Single-Line Version
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Do Bord3D4 with <nTop>,<nLeft>,<nBottom>,<nRight>,;
*--                               <cColor>,<nStyle>
*-- Example.....: Do Bord3d4 with 0,15,4,60,cColor,1
*-- Returns.....: None
*-- Parameters..: nTop    = top row
*--               nLeft   = Left column
*--               nBottom = Bottom Row
*--               nRight  = Right Column
*--               cColor  = Color of area being filled
*--               nStyle  = type of 3-d border (1 = Raised, 2 = Inset)
*-----------------------------------------------------------------------

   parameters nTop,nLeft,nBottom,nRight,cColor,nStyle

   *-- deal with border ...
   m->cBorder = set("BORDER")

   *-- figure out colors
   m->cTextColor = colorbrk(m->cColor,1)
   m->cBackColor = backcolor(m->cTextColor)
   m->cHighColor = "W+/"+m->cBackColor
   m->cShadColor = "N/"+m->cBackColor

   *-- if style is 1, we do the commands for a 'raised' border
   *-- if style is 2, we do an 'inset' border
   if m->nStyle < 1 .or. m->nStyle > 2  && if not 1 or 2 ...
      m->nStyle = 1
   endif

   if m->nStyle = 1
      *-- RAISED Border
      *-- Outside of "border"
      @m->nTop,m->nLeft to m->nTop,m->nRight     color &cHighColor.
      @m->nTop,m->nLeft to m->nBottom,m->nLeft   color &cHighColor.
      @m->nTop,m->nLeft say chr(218)             color &cHighColor.
      @m->nBottom,m->nLeft say chr(192)          color &cHighColor.
      @m->nTop,m->nRight to m->nBottom,m->nRight color &cShadColor.
      @m->nBottom,m->nLeft+1 to m->nBottom,m->nRight color &cShadColor.
      @m->nTop,m->nRight say chr(191)            color &cShadColor.
      @m->nBottom,m->nRight say chr(217)         color &cShadColor.

   else
      *-- RECESSED Border
      *-- Outside of "border"
      @m->nTop,m->nLeft to m->nTop,m->nRight     color &cShadColor.
      @m->nTop,m->nLeft to m->nBottom,m->nLeft   color &cShadColor.
      @m->nTop,m->nLeft say chr(218)             color &cShadColor.
      @m->nBottom,m->nLeft say chr(192)          color &cShadColor.
      @m->nTop,m->nRight to m->nBottom,m->nRight color &cHighColor.
      @m->nBottom,m->nLeft+1 to m->nBottom,m->nRight color &cHighColor.
      @m->nTop,m->nRight say chr(191)            color &cHighColor.
      @m->nBottom,m->nRight say chr(217)         color &cHighColor.

   endif

   *-- reset border
   set border to &cBorder.

RETURN
*-- EoP: Bord3D4

PROCEDURE Bord3D5
*-----------------------------------------------------------------------
*-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
*-- Date........: 06/02/1993
*-- Notes.......: This is an attempt to combine the 3-D border routines
*--               (BORD3D through BORD3D4) -- allowing a selection
*--               between four border styles ...
*-- Written for.: dBASE IV, 1.5 or later
*-- Rev. History: 06/02/1993
*-- Calls.......: None
*-- Called by...: Any (specifically YESNO6())
*-- Usage.......: do Bord3D5 with <nULR>,<nULC>,<nBRR>,<nBRC>,<cColor>,;
*--                               <nStyle>
*-- Example.....: do Bord3D5 with 0,0,15,60,2
*-- Returns.....: None
*-- Parameters..: nULR   = Upper Left Row (Starting Coordinates)
*--               nULC   = Upper Left Column
*--               nBRR   = Bottom Right Row (Ending Coordinates)
*--               nBRC   = Bottom Right Column
*--               cColor = Colors of Window/Box ...
*--               nStyle = Border style:
*--                        1 = Double, Raised
*--                        2 = Double, Recessed
*--                        3 = Single, Raised
*--                        4 = Single, Recessed
*-----------------------------------------------------------------------

   parameters nULR, nULC, nBRR, nBRC, cColor, nStyle
   private cBorder,cBackColor,cHighColor,cShadColor

   *-- deal with border ...
   m->cBorder = set("BORDER")
   set border to single

   *-- figure out colors
   m->cBackColor = backcolor(m->cColor)
   m->cHighColor = "W+/"+m->cBackColor
   m->cShadColor = "N/"+m->cBackColor

   if m->nStyle < 1 .or. m->nStyle > 4  && if not 1 through 4 ...
      m->nStyle = 1
   endif

   do case
      case m->nStyle = 1

         *-- Raised DOUBLE Border
         *-- Outside of "border"
         @m->nULR,m->nULC to m->nULR,m->nBRC   color &cHighColor.
         @m->nULR,m->nULC to m->nBRR,m->nULC   color &cHighColor.
         @m->nULR,m->nULC say chr(218)         color &cHighColor.
         @m->nBRR,m->nULC say chr(192)         color &cHighColor.
         @m->nULR,m->nBRC to m->nBRR,m->nBRC   color &cShadColor.
         @m->nBRR,m->nULC+1 to m->nBRR,m->nBRC color &cShadColor.
         @m->nULR,m->nBRC say chr(191)         color &cShadColor.
         @m->nBRR,m->nBRC say chr(217)         color &cShadColor.

         *-- inside of "border"
         @m->nULR+1,m->nULC+2 to m->nULR+1,m->nBRC-2 color &cShadColor.
         @m->nULR+1,m->nULC+2 to m->nBRR-1,m->nULC+2 color &cShadColor.
         @m->nULR+1,m->nULC+2 say chr(218)           color &cShadColor.
         @m->nBRR-1,m->nULC+2 say chr(192)           color &cShadColor.
         @m->nULR+1,m->nBRC-2 to m->nBRR-1,m->nBRC-2 color &cHighColor.
         @m->nBRR-1,m->nULC+3 to m->nBRR-1,m->nBRC-2 color &cHighColor.
         @m->nULR+1,m->nBRC-2 say chr(191)           color &cHighColor.
         @m->nBRR-1,m->nBRC-2 say chr(217)           color &cHighColor.

      case m->nStyle = 2

         *-- Recessed DOUBLE Border
         *-- Outside of "border"
         @m->nULR,m->nULC to m->nULR,m->nBRC   color &cShadColor.
         @m->nULR,m->nULC to m->nBRR,m->nULC   color &cShadColor.
         @m->nULR,m->nULC say chr(218)         color &cShadColor.
         @m->nBRR,m->nULC say chr(192)         color &cShadColor.
         @m->nULR,m->nBRC to m->nBRR,m->nBRC   color &cHighColor.
         @m->nBRR,m->nULC+1 to m->nBRR,m->nBRC color &cHighColor.
         @m->nULR,m->nBRC say chr(191)         color &cHighColor.
         @m->nBRR,m->nBRC say chr(217)         color &cHighColor.

         *-- inside of "border"
         @m->nULR+1,m->nULC+2 to m->nULR+1,m->nBRC-2 color &cHighColor.
         @m->nULR+1,m->nULC+2 to m->nBRR-1,m->nULC+2 color &cHighColor.
         @m->nULR+1,m->nULC+2 say chr(218)           color &cHighColor.
         @m->nBRR-1,m->nULC+2 say chr(192)           color &cHighColor.
         @m->nULR+1,m->nBRC-2 to m->nBRR-1,m->nBRC-2 color &cShadColor.
         @m->nBRR-1,m->nULC+3 to m->nBRR-1,m->nBRC-2 color &cShadColor.
         @m->nULR+1,m->nBRC-2 say chr(191)           color &cShadColor.
         @m->nBRR-1,m->nBRC-2 say chr(217)           color &cShadColor.

      case m->nStyle = 3

         *-- Raised SINGLE Border
         @m->nULR,m->nULC to m->nULR,m->nBRC color &cHighColor.
         @m->nULR,m->nULC to m->nBRR,m->nULC color &cHighColor.
         @m->nULR,m->nBRC to m->nBRR,m->nBRC color &cShadColor.
         @m->nBRR,m->nULC to m->nBRR,m->nBRC color &cShadColor.
         @m->nULR,m->nULC say chr(218)       color &cHighColor.
         @m->nBRR,m->nULC say chr(192)       color &cHighColor.
         @m->nULR,m->nBRC say chr(191)       color &cShadColor.
         @m->nBRR,m->nBRC say chr(217)       color &cShadColor.

      case m->nStyle = 4

         *-- Recessed SINGLE Border
         @m->nULR,m->nULC to m->nULR,m->nBRC color &cShadColor.
         @m->nULR,m->nULC to m->nBRR,m->nULC color &cShadColor.
         @m->nULR,m->nBRC to m->nBRR,m->nBRC color &cHighColor.
         @m->nBRR,m->nULC to m->nBRR,m->nBRC color &cHighColor.
         @m->nULR,m->nULC say chr(218)       color &cShadColor.
         @m->nBRR,m->nULC say chr(192)       color &cShadColor.
         @m->nULR,m->nBRC say chr(191)       color &cHighColor.
         @m->nBRR,m->nBRC say chr(217)       color &cHighColor.

   endcase

   *-- reset border
   set border to &cBorder.

RETURN
*-- EoP: Bord3D5

FUNCTION Bevel
*-----------------------------------------------------------------------
*-- Programmer..: Adam L. Menkes (Borland)
*-- Date........: 04/xx/1993
*-- Notes.......: Taken from the April/May issue of dTech News.
*--               This routine will create a 'beveled' area on the
*--               screen (3-d border). This is done by passing two
*--               parameters, and using the @/SAY for the starting
*--               coordinates. This defaults to the Borland "chiseled
*--               steel" look. If you want other colors, you will need
*--               to modify this routine (or use a different one, such
*--               as BORD3D or BORD3D2 in DIALOGS.PRG).
*--               Quoting from the article:
*--                 "Placing text in the screen should be done before
*--               the function is called. This way, the background color
*--               can blend in, though the text colors will become
*--               black. If you do not want the text to display in black
*--               but still want it to blend, determine the dull color
*--               color (which is the value of cClrBack in the program)
*--               and @...SAY the text with <your color>/<dull color>.
*--               See the [code] for getting colors, and use the code
*--               for getting cClrBack. For example, if your colors are
*--               "W+/B", the background color will be "W" ("+" is
*--               stripped). Assuming this was stored to the variable
*--               cBackColor and you wanted red text, the syntax would
*--               look like:
*--                       @ 5, 5 say bevel(10,60)
*--                       @10,27 say "Hello World" COLOR R/&cBackColor.
*--                 "Another feature of the UDF is the shadowing. The
*--               shadowing effect is evened out by using 1/2 height
*--               shadowing on the horizontal surface and the upper
*--               right hand corner. This gives it a more natural
*--               appearance than trying to even out the aspect ratio
*--               by using full height shadowing for the bottom,
*--               and double for the right edge. This will not work
*--               properly if you shade the entire background with a
*--               character (chr(178) as an example."
*-- Written for.: dBASE IV, 2.0
*-- Rev. History: 04/xx/1993 -- Original
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: @<x>,<y> say Bevel(<nBottom>,<nRight>)
*-- Example.....: @5,10 say bevel(10,60)
*-- Returns.....: nul
*-- Parameters..: nBottom = bottom row
*--               nRight  = right column
*-----------------------------------------------------------------------

   parameters nBottom, nRight
   private nTop, nLeft, nBottom, nRight, cAttr, cBorder, ;
           cNormFore, cEnh, cClrFore, cClrBack, cClrShad

   m->nTop    = row()
   m->nLeft   = col()
   m->nBottom = iif(pcount() < 1, max(25,val(right(set("DISPLAY"),;
                   2))) - 2, m->nBottom+m->nTop)  && maximum:lastrow - 1
   m->nRight   = iif(pcount() < 2, 78, m->nLeft+m->nRight) && maximum 78

   *-- get current color settings for highlighting-- note use of 2.0
   *-- third parm for AT()
   m->cAttr     = set("ATTRIBUTES")
*   cEnh      = substr( m->cAttr, at(",",m->cAttr)+1,;
*                      at(",",m->cAttr,2)-1-at(",",m->cAttr))
   m->cNormBack = substr(m->cAttr,at("/",m->cAttr)+1,;
                     at(",",m->cAttr)-1-at("/",m->cAttr))
   m->cClrFore  = left(m->cAttr,at("/",m->cAttr)-1)
   m->cClrFore  = m->cClrFore+iif("+"$m->cClrFore,"","+")
   m->cClrFore  = iif(m->cClrFore = "N+","W+",m->cClrFore)
   m->cClrBack  = left(m->cClrFore,len(m->cClrFore) - ;
                       iif(right(m->cClrFore,1) = "+",1,0))
   m->cClrShad  = "N"
   m->cBorder =  set("BORDER")

   *-- fill region with color
   @m->nTop, m->nLeft -1 fill to m->nBottom, m->nRight color /&cClrBack.

   *-- draw shadow
   @m->nTop+1,m->nRight+1 fill to m->nBottom,m->nRight+1 ;
                                                   color /&cClrShad.
   @m->nTop,m->nRight+1 say chr(220)     color &cClrShad./&cNormBack.
   @m->nBottom+1,m->nLeft+1 say replicate(chr(223),;
                 m->nRight-m->nLeft+1)   color &cClrShad./&cNormBack.

   *-- Draw outer lines and highlights
   @m->nTop+1,m->nLeft    to m->nBottom - 1,m->nLeft    ;
                                           color &cClrFore./&cClrBack.
   @m->nBottom,m->nLeft+1 to m->nBottom,m->nRight - 1  ;
                                           color &cClrShad./&cClrBack.
   @m->nTop,m->nLeft+1    to m->nTop,m->nRight - 1  ;
                                           color &cClrFore./&cClrBack.
   @m->nTop+1,m->nRight   to m->nBottom-1,m->nRight ;
                                            color &cClrShad./&cClrBack.

   *-- Draw inner lines and highlights
   @m->nTop+2,m->nLeft+2    to m->nBottom-2,m->nLeft+2 ;
                                            color &cClrShad./&cClrBack.
   @m->nBottom-1,m->nLeft+3 to m->nBottom-1,m->nRight-3;
                                            color &cClrFore./&cClrBack.
   @m->nTop+1,m->nLeft+3    to m->nTop+1,m->nRight-3 ;
                                            color &cClrShad./&cClrBack.
   @m->nTop+2,m->nRight-2   to m->nBottom-2,m->nRight-2 ;
                                            color &cClrFore./&cClrBack.

   *-- Draw outer corners
   @m->nTop,m->nLeft     say chr(218)     color &cClrFore./&cClrBack.
   @m->nBottom,m->nLeft  say chr(192)     color &cClrFore./&cClrBack.
   @m->nTop,m->nRight    say chr(191)     color &cClrShad./&cClrBack.
   @m->nBottom,m->nRight say chr(217)     color &cClrShad./&cClrBack.

   *-- Draw inner corners
   @m->nTop+1,m->nLeft+2     say chr(218) color &cClrShad./&cClrBack.
   @m->nBottom-1,m->nLeft+2  say chr(192) color &cClrShad./&cClrBack.
   @m->nTop+1,m->nRight-2    say chr(191) color &cClrFore./&cClrBack.
   @m->nBottom-1,m->nRight-2 say chr(217) color &cClrFore./&cClrBack.

   *-- cleanup
   set border to &cBorder.

RETURN ""
*-- EoF: Bevel()

*-----------------------------------------------------------------------
*-- COLOR and other routines needed by those above
*-----------------------------------------------------------------------

PROCEDURE Shadow
*-----------------------------------------------------------------------
*-- Programmer..: Ashton-Tate
*-- Date........: 01/27/1992
*-- Notes.......: Creates a shadow for a window (taken from the dBASE IV
*--               picklist functions)
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 05/23/1991 - original procedure.
*--               12/14/1991 - Modified by Jim Magnant (TXAGGIE) - to
*--               check for columns exceeding 79, and temporarily change
*--               last col. value (so routine doesn't "blow up").
*--               01/27/1992 -- Modified by Ken Mayer to check for
*--               bottom of screen, based on what Jim did above.
*--               No further than 23.
*--               06/02/1993 -- Modified to handle screens larger than
*--               24 lines.
*-- Calls.......: None
*-- Called by...: Too many to list ...
*-- Usage.......: do shadow with <nULRow>,<nULCol>,<m->nBRRow>,<nBRCol>
*-- Example.....: save screen to sMain
*--               activate screen
*--               define window wError from 5,15 to 15,65 double color;
*--                    rg+/r,rg+/r,rg+/r
*--               do shadow with 5,15,15,65
*--               activate window WError
*--                && perform actions in window
*--               deactivate window WError
*--               release window WError
*--               restore screen from sMain
*--               release screen sMain
*-- Returns.....: None
*-- Parameters..: nULRow = Upper Left Row position
*--               nULCol = Upper Left Column position (x,y)
*--               nBRRow = Bottom Right Row position
*--               nBRCol = Bottom Right Column position (x2,y2)
*-----------------------------------------------------------------------

   parameters nULRow,nULCol,nBRRow,nBRCOL
   private nTempRow,nTempCol,nIncRow,nIncCol

   *-- if screen is larger than 24 lines (EGA43, EGA50 ...)
   m->cScreen = set("DISPLAY")
   if m->cScreen = "MONO"
      m->nScreen = 23
   else
      m->nScreen = val(right(m->cScreen,2))-2
   endif

   m->nTempRow = iif(m->nBRRow+1>m->nScreen,m->nScreen,m->nBRRow+1)
   m->nTempCol = iif(m->nBRCol+2>79,79,m->nBRCol+2)
   m->nIncRow = 1
   m->nIncCol = (m->nBRCol-m->nULCol) / (m->nBRRow-m->nULRow)
   do while m->nTempRow <> m->nULRow .or. m->nTempCol <> m->nULCol+2
      m->nRightCol = m->nBRCol
      m->nBRCol = iif(m->nBRCol + 2 > 79,77,m->nBRCol)
      m->nBotRow = m->nBRRow
      m->nBRRow = iif(m->nBRRow + 1 > m->nScreen,m->nScreen-1,m->nBRRow)
      @ m->nTempRow,m->nTempCol fill to m->nBRRow+1,m->nBRCol+2 ;
                                                    color n+/n
      m->nBRCol = m->nRightCol
      m->nBRRow = m->nBotRow
      m->nTempRow = iif(m->nTempRow<>m->nULRow,m->nTempRow - ;
                                           m->nIncRow,m->nTempRow)
      m->nTempCol = iif(m->nTempCol<>m->nULCol+2,m->nTempCol - ;
                                           m->nIncCol,m->nTempCol)
      m->nTempCol = iif(m->nTempCol<m->nULCol+2,m->nULCol+2,m->nTempCol)
   enddo

RETURN
*-- EoP: Shadow

PROCEDURE SMultPick
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1305)
*-- Date........: 01/16/1993
*-- Notes.......: Does screen display loop for Multipick procedure.
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: Original function 01/16/1993.
*-- Calls.......: None
*-- Called by...: Multipick
*-- Usage.......: DO SMultpick
*-- Parameters..: None, but procedure uses various variables set by the
*--               parent Multipick procedure.
*-----------------------------------------------------------------------

   private nThisOff, nThisRow, nThisElem, nHiRow, nR
   m->nThisOff = 0
   m->nR = min( m->nRo, m->nElems - m->nTop + 1 )
   do while m->nThisOff < m->nRo
      m->ThisRow = m->nDown + m->nThisOff
      m->ThisElem = m->nTop + m->nThisOff
      if m->nThisoff < m->nR
         if m->ThisElem = m->nHigh
            @ m->ThisRow, m->m->nRight say m->cBoxL + ;
              iif( &cArray.[ m->ThisElem, 2], ;
              m->cChar, " " ) + m->cBoxR color &cHigh.
            @ m->ThisRow, col() say left( &cArray.[ m->ThisElem, 1 ] ;
              + space( m->nLength ), m->nLength ) color &cHigh.
              nHiRow = m->ThisRow
         else
            @ m->ThisRow, m->nRight say m->cBoxL + ;
              iif( &cArray.[ m->ThisElem, 2], ;
              m->cChar, " " ) + m->cBoxR color &cNorm.
            @ m->ThisRow, col() say left( &cArray.[ m->ThisElem, 1 ] ;
              + space( m->nLength ), m->nLength ) color &cNorm.
         endif
      else
         @ m->ThisRow, m->nRight say space( m->nCkCol + len( m->cBoxR );
           + m->nLength )
      endif
      m->nThisoff = m->nThisOff + 1
   enddo
   @ m->nLast, m->nLPad say " Done " color &cQuit.
   @ m->nLast, m->nRPad say "Cancel" color &cQuit.
   @ m->nHiRow, m->nCkCol say ""

RETURN
*-- EoP: SMultPick

FUNCTION YesQuit
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons  (CIS: 72662,1302)
*-- Date........: 02/24/1993
*-- Notes.......: Asks whether to quit and cancel changes; does so if
*--               yes.
*-- Written for.: dBASE IV, Version 1.5.
*-- Rev. History: 02/.24/1993 -- Original Release
*-- Calls.......: YnMouse()            Function in SCREENS.PRG
*-- Called by...: Multipick
*-- Usage.......: YesQuit()
*-- Example.....: ? Yesquit()
*-- Parameters..: None
*-- Returns.....: Logical, .T. for "Yes" or .F. for "No"
*-- Side effects: If "Yes", restores cArray[ , 2 ] values from cTemp
*-----------------------------------------------------------------------

   private nX, lRet

   m->lRet = YnMouse( "","Do you wish to restore", ;
               "the original selection","and leave this routine?" )
   if m->lRet
      m->nX = 1
      do while m->nX <= m->nElems
         store cTemp[m->nX] to &cArray.[ m->nX, 2 ]
         m->nX = m->nX + 1
      enddo
   endif

RETURN m->lRet
*-- EoF: YesQuit()

FUNCTION YnMouse
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/28/1993
*-- Notes.......: Returns .T. or .F. answer to question without leaving
*--               mouse droppings.  Will not respond to left arrow
*--               properly unless set( "ESCAPE" ) is off.
*--               *******************************
*--               **** REQUIRES MUSCLICK.BIN ****
*--               *******************************
*-- Written for.: dBASE IV, Version 1.5.
*-- Rev. History: 02/23/93 - original function
*--               02/28/93 - revised to support right and left arrows
*-- Calls.......: HighColors()          Function in COLOR.PRG
*--               Center                Procedure in PROC.PRG ( if
*--                                     centering )
*-- Called by...: Any
*-- Usage.......: YnMouse( <cColors>, <cP1> [, <cP2>...] [,<lYes>] )
*-- Example.....: ? YnMouse( "", "Are you sure?" )
*-- Parameters..: cColors   -   String, either blank or holding desired
*--                             colors as standard [ , enhanced [,
*--                             border ] ]
*--               cP<n>     -   One or more strings of prompt
*--                             characters.
*--                             < only 7 may be passed as literals using
*--                             dBASE IV 1.5 >.  They will be printed
*--                             one below the other.  There may not in
*--                             any event be more than the number of
*--                             useable screen rows less 6; the
*--                             parameters line will have to be changed
*--                             to use more than 20. As furnished, the
*--                             justification of the prompt strings is
*--                             flush left.  To center them, see the
*--                             commented lines in the code.
*--                             Centering uses the Center procedure in
*--                             PROC.PRG.
*--               lYes      -   A logical .T. if the default answer is
*--                             "Yes". This must be the last parameter,
*--                             but it may follow any number of prompt
*--                             lines.
*-- Returns.....: Logical, .T. for "Yes" or .F. for "No"
*-----------------------------------------------------------------------

   parameters cColors, cP01, cP02, cP03, cP04, cP05, cP06, cP07, cP08,;
             cP09, cP10, cP11, cP12, cP13, cP14, cP15, cP16, cP17, ;
             cP18, cP19, cP20, lYes

   private cYn, nX, lY, nParams, nRows, nCols, cWhich, nBot, nTop, nLeft
   private cColrs, cPads, nLPad, nRpad, lRet, nScr

   * obtain number of prompts, and default answer if provided
   m->nParams = pcount() - 1
   m->lY = .F.
   * if we have 22 parameters, last must be the default answer
   if m->nParams = 21
      m->lY = m->lYes
   * otherwise look at the last parameter's type--if it is logical
   * that's the default answer and not a prompt
   else
      m->cWhich = "cP" + right( str( 100 + m->nParams ), 2 )
      if type( m->cWhich ) = "L"
         m->lY = &cWhich.
         m->nParams = m->nParams - 1
      endif
   endif

   * we need six rows for top and bottom borders, space before prompts,
   * space after prompts, yes/no pads and space after them
   m->nRows = m->nParams + 6
   m->nScr = iif( "43" $ set( "DISPLAY" ), 43, 25 )

   * don't overwrite messages, status or scoreboard
   m->nBot = m->nScr - 2
   m->nTop = 0
   if set( "STATUS" ) = "ON"
      m->nBot = m->nBot - 2
   else
      if set( "SCOREBOARD" ) = "ON"
         m->nTop = 1
      endif
   endif
   if m->nRows > m->nBot - m->nTop
      activate screen
      ? "Too many prompt lines for screen size - aborting"
      wait
      cancel
   endif

   * find longest prompt line and window width it requires including
   * a space at both ends
   m->nX = 1
   m->nCols = 13               && 11 spaces for the pads, 2 for border
   do while m->nX <= m->nParams
      m->cWhich = "cP" + right( str( 100 + m->nX ), 2 )
      m->nCols = max( m->nCols, len( trim( &cWhich. ) ) + 2 )
      m->nX = m->nX + 1
   enddo

   * round up to even number of columns in order to center the window
   m->nCols = 2 * ceiling( m->nCols/ 2 )
   if m->nCols > 80
      activate screen
      ? "Prompts are too long for screen - aborting"
      wait
      cancel
   endif

   * calculate screen row of top and bottom of centered window
   m->nTop = max( m->nTop, int( ( m->nScr - m->nRows ) / 2 ) )
   m->nBot = m->nTop + m->nRows


   * and screen column of left edge
   m->nLeft = 39 - m->nCols / 2

   * obtain colors to use, using highlight for pads
   m->cColrs = iif( "" # m->cColors, m->cColors, set( "ATTRIBUTES" ) )
   if "&" $ m->cColrs
      m->cColrs = left( m->cColrs, at( "&", m->cColrs ) - 1  )
   endif
   m->cPads = HighColors( m->cColrs )

   * calculate column positions of yes/no pads
   m->nLPad = int( ( m->nCols - 2 ) / 4 ) - 2
   m->nRPad = m->nCols - m->nLPad - 6

   * now open the window and print prompts
   define window cYn from m->nTop, m->nLeft to m->nBot, ;
                         m->nLeft + m->nCols color &cColrs.
   activate window cYn
   m->nX = 1
   do while m->nX <= m->nParams
      m->cWhich = "cP" + right( str( 100 + m->nX ), 2 )
      *  To change from flush left to centered justification of the
      *  prompts, uncomment the next code line and comment out the one
      *  following.
      *  You will then need the "Center" procedure in PROC.PRG.
      *         do Center with m->nX, m->nCols, "", &cWhich.
      @ m->nX, 1 say &cWhich.
      m->nX = m->nX + 1
   enddo

   * print pads
   @ m->nX + 1, m->nLPad say " Yes " color &cPads.
   @ m->nX + 1, m->nRPad say "  No " color &cPads.
   @ m->nX + 1, iif( m->lY, m->nLPad, m->nRPad ) + 2 say ""

   * and begin a loop that may last forever
   clear typeahead
   do while .T.
      m->nk = inkey()
      if m->nk = 0
         loop
      endif
      do case
         case m->nk = 89 .or. m->nk = 121    && 'Y' or 'y'
            m->lRet = .T.
            exit
          case m->nK = 78 .or. m->nK = 110 .or. m->nK = 27
                                             && 'N' or 'n' or Esc
            m->lRet = .F.
            exit
         case m->nK = 13 .or. m->nK = 23     && Enter or Ctrl-End
            m->lRet = m->lY
            exit
         case m->nK = 4 .or. m->nK = 19      && right or left arrow
            m->lY = .not. m->lY
            @ m->nX + 1, iif( m->lY, m->nLPad, m->nRPad ) + 2 say ""
         case type( "nG_MusClic" ) = "N" .and. m->nk = m->nG_MusClic
            store chr(255) to m->cMRow, m->cMCol
            call MUSCLICK with m->cMRow, m->cMCol
            m->nMRow = asc( m->cMRow )
            m->nMCol = asc( m->cMCol )
           if m->nMRow = m->nTop + m->nX + 2      && one more for border
             if m->nMCol >= m->nLPad + m->nLeft .and. ;
                m->nMCol < m->nLPad + m->nLeft + 5
                m->lRet = .T.
                exit
             endif
             if m->nMCol >= m->nRPad + m->nLeft .and. ;
                m->nMCol <m->nRPad + m->nLeft + 5
                m->lRet = .F.
                exit
             endif
           endif
      endcase
   enddo
   deactivate window cYn
   release window cYn

RETURN m->lRet
*-- EoF: YnMouse()

FUNCTION CWnDecode
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/06/1993
*-- Notes.......: Returns the numeric value of one of the four codes for
*--               edges of the window held in a string of the type
*--               returned by cWnSize.  These represent numbers of rows
*--               or columns.
*-- Written for.: dBASE IV, Versions 1.0 - 1.5.
*-- Rev. History: 02/06/1993 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: cWnDecode( <cWnString>,<cEdge>|<nPos> )
*-- Example.....: cWim->nTop = cWnDecode( cWin, "T" )
*-- Parameters..: cWnString -   A string returned by CWnSize
*--               cEdge -       A character parameter beginning with one
*--                             of the four characters "T","L","B",or
*--                             "R", ( upper or lower case ), OR
*--               nPos  -       A number indicating the position in the
*--                             cWnString of the code for the edge.
*--                             These correspond to the following:
*--                             Window edge       cEdge       nPos
*--                               top              T           1
*--                               left             L           2
*--                               bottom           B           3
*--                               right            R           4
*--                             Either cEdge or nPos must be furnished,
*--                             not both.
*-- Returns.....: numeric value of the row or column; -1 for argument
*--               out of range or cWnString holds garbage or is empty.
*-----------------------------------------------------------------------

   parameters cWnString, xEdge
   private nPos, nRet

   m->nRet = -1
   if type( "xEdge" ) = "C"
      m->nPos = at( upper( left( m->xEdge, 1 ) ), "TLBR" )
   else
      if type( "xEdge" ) = "N"
         m->nPos = m->xEdge
      endif
   endif
   if m->nPos > 0 .and. m->nPos < 5 .and. len( m->cWnString ) = 4
      m->nRet = asc( substr( m->cWnString, m->nPos, 1 ) ) - 1
   endif
   if m->nRet > iif( mod( m->nPos, 2 ) > 0, 43, 80 )
      m->nRet = -1
   endif

RETURN m->nRet
*-- EoF: CWnDecode

FUNCTION CWnSize
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/06/1993
*-- Notes.......: Returns a string of four characters which are chr()
*--               values of one more each than the top, left, bottom
*--               and right row and column numbers of the usable surface
*--               of the current window, or of the screen.  ( one more
*--               to avoid chr( 0 ) problems )
*--               Returns "" if unable to find VDCURSOR.BIN
*--               *******************************
*--               **** REQUIRES VDCURSOR.BIN ****
*--               *******************************
*-- Written for.: dBASE IV, Versions 1.0 - 1.5.
*-- Rev. History: 02/06/1993 -- Original Release
*-- Calls.......: nWBsrch()           function included
*-- Called by...: Any
*-- Usage.......: cWnSize()
*-- Example.....: cWin = cWnSize()
*--               WinBot = asc( substr( cWin, 3 1 ) )
*-- Parameters..: None
*-- Returns.....: character string of four chr() values, or "" if error
*-- Side effects: Called function nWBsrch disables any error trap
*-----------------------------------------------------------------------

   private nHi, nLo, nL, cV

   m->cV = ""
   if file( "VDCURSOR.BIN" )
      load VDCURSOR
      @ 0,0 say ""
      m->cV = call( "VDCURSOR","  " )
      release module VDCURSOR
      * reverse bytes so row comes first
      m->cV = right( m->cV, 1 ) + left( m->cV, 1 )
      * this is the first row, and one more than maximum last
      m->nL = asc( m->cV ) - 1
      m->nLo = m->nL
      m->nHi = 44
      m->cV = m->cV + chr( m->nL + nWBsrch( m->nLo, m->nHi, "Down" );
              + 1 )
      * first column and one more than last
      m->nL = asc( substr( m->cV, 2, 1 ) ) - 1
      m->nLo = m->nL
      m->nHi = 80
      m->cV = m->cV + chr( m->nL + nWBsrch( m->nLo, m->nHi, "Across" );
              + 1 )
   endif

RETURN m->cV
*-- EoF: CWnSize()

FUNCTION nWBsrch
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/06/1993
*-- Notes.......: special binary search routine for window edges
*-- Written for.: dBASE IV, Versions 1.0 - 1.5.
*-- Rev. History: 02/06/1993 -- Original Release
*-- Calls.......: None
*-- Called by...: cWnSize
*-- Usage.......: nWBsrch( < nLo >, < nHi >, < cDir > )
*-- Example.....: Lastrow = nWBsrch( 0, 44, "Down" )
*-- Parameters..: nLo           Number, top row or left column
*--               nHi           Number, bottom or right screen edge + 1
*--               cDir          char, direction - "Down" or "Across"
*-- Returns.....: number of highest row or column that may be written to
*-- Side effects: Disables any ON ERROR trap
*-----------------------------------------------------------------------

   parameters nLo, nHi, cDir
   private lToohigh, nTry, cD

   m->cD = upper( left( m->cDir, 1 ) )
   do while m->nHi > m->nLo + 1
      m->lTooHigh = .F.
      nTry = int( ( m->nHi + m->nLo ) / 2 )
      on error m->lTooHigh = .T.
      if m->cD $ "DB"
         @ nTry, 0 say ""
      else
         @ 0, nTry say ""
      endif
      if m->lTooHigh
         m->nHi = nTry - 1
      else
         m->nLo = nTry
      endif
   enddo
   on error

RETURN m->nLo
*-- EoF(): nWBsrch

FUNCTION ColorBrk
*-----------------------------------------------------------------------
*-- Programmer..: Ken Mayer (CIS: 71333,1030)
*-- Date........: 03/24/1993
*-- Notes.......: This routine is designed to be used with any of my
*--               functions and procedures that accept a memory variable
*--               for color, and use a window. It's purpose is to break
*--               that color var into it's components (depending on
*--               which one the user wants) and return those components,
*--               so that they can then be used in SET COLOR OF ...
*--               commands.
*-- Written for.: dBASE IV, 1.1, 1.5 (written because of 1.5, but will
*--               work in 1.1)
*-- Rev. History: 07/22/1992 - modified to handle memvars/color strings
*--               that may have only two parts to them (no <border>...),
*--               so that if the <nField> parm is 2, we get a valid
*--               value.
*--               03/24/1993 -- Lee Hite - Fixed to work correctly when
*--               <cColorVar> contains a single colorset (i.e., "b/w").
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: ColorBrk(<cColorVar>,<nField>)
*-- Example.....: set color of normal to ColorBrk(cColor,1)
*-- Returns.....: Either the field you asked for (1 thru 3) or null
*--               string ("").
*-- Parameters..: cColorVar = Color variable to extract data from
*--                   Assumes the form: <main color>,<highlight>,;
*--                                     <border>
*--                   Where each part uses: <foreground>/<background>
*--                                          format
*--                    i.e., rg+/gb,w+/b,rg+/gb
*--               nField    = Field you want to extract
*-----------------------------------------------------------------------

   parameters cColorVar, nField
   private cReturn, cExtract

   do case
      case m->nField = 1
         if at(",",m->cColorVar) > 0
            m->cReturn = left(m->cColorVar,at(",",m->cColorVar)-1)
         else
            m->cReturn = m->cColorVar
         endif
      case m->nField = 2
         m->cExtract = substr(m->cColorVar,at(",",m->cColorVar)+1)
                          && everything to right of comma
         if at(",",m->cExtract) > 0
            m->cReturn = left(m->cExtract,at(",",m->cExtract)-1)
                          && left of second ,
         else
            m->cReturn = m->cExtract
         endif
      case m->nField = 3
         m->cExtract = substr(m->cColorVar,at(",",m->cColorVar)+1)
         if at(",",m->cExtract) > 0
            m->cReturn = substr(m->cExtract,at(",",m->cExtract)+1)
         else
            m->cReturn = ""
         endif
      otherwise
         m->cReturn = ""
   endcase

RETURN m->cReturn
*-- EoF: ColorBrk()

FUNCTION FBClrBrk
*-----------------------------------------------------------------------
*-- Programmer..: Joey D. Carroll (JOEY on USSBBS)
*-- Date........: 11/12/1992
*-- Notes.......: Extracts foreground/background colors from a string in
*--               the form of a literal "n/gb" or of a variable.  It is
*--               useful to use COLORBRK() to obtain this value.
*-- Written for.: dBASE IV, ver 1.5
*-- Rev. History: 11/12/1992 -- Original
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: ?? FBClrBrk("B","w+/gr")
*-- Example.....: cNormalClr = "w+/gr"
*--               cForeClr   = FBClrBrk("F",cNormalClr)   && = "w+"
*--               cBackClr   = FBClrBrk("B",cNormalClr)   && = "gr"
*-- Returns.....: a sub-string of cColor
*-- Parameters..: cType  = "F" for foreground color  "B" for Background
*--               cColor = the color you want to extract from
*-----------------------------------------------------------------------

   parameters cType,cColor
   private cRetClr

   if upper(cType) = "F"
      m->cRetClr = iif(at("/",m->cColor) = 0,m->cColor,;
                   left(m->cColor,at("/",m->cColor)-1))
   else           && = "B"
      m->cRetClr = substr(m->cColor,at("/",m->cColor) + 1,2)
   endif

RETURN m->cRetClr
*-- EoF: FBClrBrk()

FUNCTION BackColor
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/24/1993
*-- Notes.......: Returns background part of color string.
*-- Written for.: dBASE IV, Version 1.5.
*-- Rev. History: 02/04/1993 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: BackColor( <cColor> )
*-- Example.....: ? BackColor( "N/BG" )
*-- Parameters..: cColor    -   String holding color foreground and
*--                             background
*-- Returns.....: Character, string with background portion of the color
*--               Returns empty string if no such portion.
*-----------------------------------------------------------------------

   parameters cColor
   private cRet

   m->cRet = upper( trim( ltrim( m->cColor ) ) )
   if "/" $ m->cRet
      m->cRet = substr( m->cRet, at( "/", m->cRet ) + 1 )
      if "*" $ m->cRet
         m->cRet = stuff( m->cRet, at( "*", m->cRet ), 1, "" )
      endif
      if "+" $ m->cRet
         m->cRet = stuff( m->cRet, at( "+", m->cRet ), 1, "" )
      endif
   else
      m->cRet = ""
   endif

RETURN upper( ltrim( trim( m->cRet ) ) )
*-- EoF: BackColor()

FUNCTION NormColors
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/23/1993
*-- Notes.......: Returns the "normal" portion of a color string
*-- Written for.: dBASE IV, Version 1.5.
*-- Rev. History: 02/23/1993 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: NormColors( <cColor> )
*-- Example.....: ? NormColors( "N/BG,BG+/N,W+/B" )
*-- Parameters..: cColor    -   String holding colors
*-- Returns.....: Character, normal color portion of string.
*-----------------------------------------------------------------------

   parameters cColor
   private cRet

   m->cRet = m->cColor
   if "," $ m->cRet
      m->cRet = left( m->cRet, at( ",", m->cRet ) - 1 )
   endif

RETURN upper( ltrim( trim ( m->cRet ) ) )
*-- EoF: NormColors()

FUNCTION HighColors
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/23/1993
*-- Notes.......: Returns the "highlight" portion of a color string
*-- Written for.: dBASE IV, Version 1.5.
*-- Rev. History: 02/23/1993 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: HighColors( <cColor> )
*-- Example.....: ? HighColors( "N/BG,BG+/N,W+/B" )
*-- Parameters..: cColor    -   String holding colors
*-- Returns.....: Character, highlight color portion of string.
*--               Returns empty string if no such portion.
*-----------------------------------------------------------------------

   parameters cColor
   private cRet

   m->cRet = ""
   if "," $ m->cColor
      m->cRet = substr( m->cColor, at( ",",m->cColor ) + 1 )
      if "," $ m->cRet
         m->cRet = left( m->cRet, at( ",", m->cRet ) - 1 )
      endif
   endif

RETURN upper( ltrim( trim( m->cRet ) ) )
*-- EoF: HighColors()

FUNCTION ForeColor
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 02/24/1993
*-- Notes.......: Returns foreground part of color string.
*-- Written for.: dBASE IV, Version 1.5.
*-- Rev. History: 02/24/1993 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: ForeColor( <cColor> )
*-- Example.....: ? ForeColor( "N/BG" )
*-- Parameters..: cColor    -   String holding color foreground and
*--                             background
*-- Returns.....: Character, string with foreground portion of the color
*-----------------------------------------------------------------------

   parameters cColor
   private cRet

   m->cRet = upper( trim( ltrim( m->cColor ) ) )
   if "/" $ m->cRet
      m->cRet = left( m->cRet, at( "/", m->cRet ) - 1 )
   endif
   if "*" $ m->cColor
      m->cRet = m->cRet + "*"
   endif
   if "+" $ m->cColor
      m->cRet = m->cRet + "+"
   endif

RETURN m->cRet
*-- EoF: ForeColor()

PROCEDURE ReColor
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 04/23/1992
*-- Notes.......: Restores colors to those held in a string of the form
*--               returned by set("ATTRIBUTE").
*-- Written for.: dBASE IV, Versions 1.0 - 1.5.
*-- Rev. History: 04/23/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: DO ReColor WITH <cColors>
*-- Example.....: DO Recolor WITH OldColors
*-- Parameters..: cColors = a string in the form returned by
*--                         set("ATTRIBUTE").
*-- Returns.....: None
*-- Side effects: Changes the screen colors.
*-----------------------------------------------------------------------

   parameters cColors
   private cThis, cNext, nAt, cLeft, nX, cAreas

   m->cAreas = "   NORMHIGHBORDMESSTITLBOX INFOFIEL"
   m->cLeft = m->cColors + ", "
   m->nX = 0
   do while m->nX < 8
      m->nX = m->nX + 1
      cThis = substr( m->cAreas, 4 * m->nX, 4 )
      if m->nX = 3
         m->nAt = at( "&", m->cLeft )
         m->cNext = left( m->cLeft, m->nAt - 2 )
         m->cLeft = substr( m->cLeft, m->nAt + 3 )
         SET COLOR TO , , &cNext.
      else
         m->nAt = at( ",", m->cLeft )
         m->cNext = left( m->cLeft, m->nAt - 1 )
         m->cLeft = substr( m->cLeft, m->nAt + 1 )
         SET COLOR OF &cThis TO &cNext.
      endif
   enddo

RETURN
*-- EoP: ReColor

PROCEDURE WordWrap
*-----------------------------------------------------------------------
*-- Programmer..: David Frankenbach (CIS: 72147,2635)
*-- Date........: 01/14/1993 (Version 1.1)
*-- Notes.......: Wraps a long string, breaking it into strings that
*--               have a maximum length of nWidth. The first output is
*--               displayed @nRow, nCol. Words are not split ...
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 01/06/1993 -- Original Release (Version 1.0)
*--               01/14/1993 -- Version 1.1 -- Corrected side-effect of
*--                       destroying string arg, added test for
*--                       string[nWidth+1] = " "
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: do WordWrap with <nRow>, <nCol>, <cString>, <nWidth>
*-- Example.....: do WordWrap with 2,2,cText,38
*-- Returns.....: None
*-- Parameters..: nRow     = Row to display first line at
*--               nCol     = Left side of area to display text at
*--               cString  = text to wrap
*--               nWidth   = Width of area to wrap text in
*-----------------------------------------------------------------------

   parameters nRow, nCol, cString, nWidth
   private cTemp, nI, cStr

   m->cStr = m->cString           && work with a COPY of input, to avoid
                                  && destroying original

   do while len(m->cStr) > 0      && while there's something to work on
      if (m->nWidth < len(m->cStr))
         m->nI = m->nWidth        && look for last " " in first nWidth

         if substr(m->cStr,m->nI+1,1) # " "
            do while ((m->nI > 0) .and. (substr(m->cStr,m->nI,1) # " "))
               m->nI = m->nI - 1
            enddo
         endif

         if m->nI = 0              && no spaces
            m->nI = m->nWidth      && get first nWidth characters
         endif
      else
         m->nI = len(m->cStr)      && use the rest of the string
      endif

      cTemp = left(m->cStr,m->nI) && get the part we're going to display

      if m->nI < len(m->cStr)         && remove that part
         m->cStr = ltrim(substr(m->cStr,m->nI + 1))
      else
         m->cStr = ""
      endif

      *-- display it
      @m->nRow,m->nCol say m->cTemp

      *-- move to next row
      m->nRow = m->nRow + 1

   enddo

RETURN
*-- EoP: WordWrap

PROCEDURE Center
*-----------------------------------------------------------------------
*-- Programmer..: Miriam Liskin
*-- Date........: 05/24/1991
*-- Notes.......: Centers text on the screen with @says
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: This and all other procedures/functions listed in this
*--               file attributed to Miriam Liskin came from "Liskin's
*--               Programming dBASE IV Book". Very good, worth the money
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: do center with <nLine>,<nWidth>,"<cColor>","<cText>"
*-- Example.....: do center with 5,65,"RG+/GB",;
*--                                   "WARNING! This will blow up!"
*--                  Note that the color field may be blank: ""
*-- Returns.....: None
*-- Parameters..: nLine  = Line or Row for @/Say
*--               nWidth = Width of screen
*--               cColor = Colors to be used ("Forg/Back") (may be nul
*--                        "", in order to use the default colors of
*--                        window/screen)
*--               cText  = Message to center on screen
*-----------------------------------------------------------------------

   parameters nLine,nWidth,cColor,cText
   private nCol

   m->nCol = (m->nWidth - len(m->cText)) /2
   @m->nLine,m->nCol say m->cText color &cColor.

RETURN
*-- EoP: Center

FUNCTION AllTrim
*-----------------------------------------------------------------------
*-- Programmer..: Phil Steele (from PCSDEMO.PRG -- Public Domain)
*-- Date........: 05/23/1991
*-- Notes.......: Complete trims edges of field (left and right)
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 05/23/1991 -- Original
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: alltrim(<cString>)
*-- Example.....: ? alltrim("  Test String  ")
*-- Returns.....: Trimmed string, i.e.:"Test String"
*-- Parameters..: cString = string to be trimmed
*-----------------------------------------------------------------------

   parameters cString

RETURN ltrim(rtrim(m->cString))
*-- EoF: AllTrim()

FUNCTION Justify
*-----------------------------------------------------------------------
*-- Programmer..: Roland Bouchereau (Ashton-Tate/Borland)
*-- Date........: 03/24/1993
*-- Notes.......: Used to pad a field/string on the right, left or both,
*--               justifying or centering it within the length
*--               specified. If the length of the string passed is
*--               greater than the size needed, the function will
*--               truncate it. Taken from Technotes, June 1990.
*--               Defaults to Left Justify if invalid TYPE is passed ...
*-- Written for.: dBASE IV, 1.0
*-- Rev. History: Original function 06/15/1991
*--               12/17/1991 -- Modified into ONE function from three by
*--                  Ken Mayer, added a third parameter to handle that.
*--               12/23/1992 -- Modified by Joey Carroll to use STUFF()
*--                  instead of TRANSFORM().
*--               03/24/1993 -- Modified by Lee Hite, as the center
*--                  option wasn't working quite right ...
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Justify(<cFld>,<nLength>,"<cType>")
*-- Example.....: ?? Justify(Address,25,"R")
*-- Returns.....: Padded/truncated field
*-- Parameters..: cFld    =  Field/Memvar/Character String to justify
*--               nLength =  Width to justify within
*--               cType   =  Type of justification: L=Left, C=Center,
*--                          R=Right
*-----------------------------------------------------------------------

   parameters cFld,nLength,cType
   private cReturn

   m->cType = upper(m->cType)    && just making sure ...
   if type("cFld")+type("nLength")+type("cType") $ "CNC,CFC"
      *-- set a picture function of 'X's, with @I,@J or @B function
      m->cReturn = space(m->nLength)
      m->cReturn = stuff(m->cReturn,;
            iif(m->cType = "C",((m->nLength-len(m->cFld))/2)+1,;
            iif(m->cType = "R",m->nLength-len(m->cFld)+1,1)),;
            len(m->cFld),m->cFld)
   else
      m->cReturn = ""
   endif

RETURN m->cReturn
*-- EoF: Justify()

FUNCTION ArrayRows
*-----------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 72662,1302)
*-- Date........: 03/01/1992
*-- Notes.......: Number of Rows in an array
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: ArrayRows("<aArray>")
*-- Example.....: n = ArrayRows("aTest")
*-- Returns.....: numeric
*-- Parameters..: aArray      = Name of array
*-----------------------------------------------------------------------

   parameters aArray
   private nHi, nLo, nTrial, nDims

   m->nLo = 1
   m->nHi = 1170
   if type( "&aArray[ 1, 1 ]" ) = "U"
      m->nDims = 1
   else
     m->nDims = 2
   endif
   do while .T.
     m->nTrial = int( ( m->nHi + m->nLo ) / 2 )
     if m->nHi < m->nLo
        exit
     endif
     if m->nDims = 1 .and. type( "&aArray.[ m->nTrial ]" ) = "U" .or. ;
        m->nDims = 2 .and. type( "&aArray.[ m->nTrial, 1 ]" ) = "U"
        m->nHi = m->nTrial - 1
     else
        m->nLo = m->nTrial + 1
     endif
   enddo

RETURN m->nTrial
*-- EoF: ArrayRows()

*-----------------------------------------------------------------------
*-- End of Program: DIALOGS.PRG
*-----------------------------------------------------------------------